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INTRODUCTION 


This manual presents a general description of the STARS-2P digital 
computer program. FORTRAN IV is used exclusively in writing the various 
subroutines. The execution of this program requires the use of thirteen 
temporary storage units. 

The program was initially written and debugged on the IBM 370-165 computer 
and then converted to the UNTVAC 1108 computer, where it utilizes 
approximately 60,000 words of core. Only basic FORTRAN Library routines 
are required by the program these being: sine, cosine, absolute value, 
and square root. 

For ease and speed in usage, the Table of Contents on the following page 
has also been laid out to present the call sequence of the program. 
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SUBROUTINE MAIN 


MAIN is the control link for the entire program. Sizing values are read 
into the program, as well as information for potential load cycling or 
changes and the material property tables. Calls are made to subroutines 
RHMAN and SEGMAT onee for each segment in a region; then subroutine 
REGMAT is called. This procedure is executed once for every region in the 
structure. Finally calls to subroutines STRMAT, INITAL and LEBEGE are made. 

Subroutine SHPLAS (which is actually called from LEBEGE) updates all the 
information per load step, and allows the program to loop back to MAIN for 
the next load increment. If the loading is cycling or progressively 
changing, the updates for, the next load pattern are made before proceeding 
with the program loopB. 

There are also several counters in this control link. These are defined 
as follows: 

NSC - Counts the calls to subroutines RUMAN and SEGMAT, from 
1 to the number of segments within a region. 

NRC - Counts the calls to subroutine REGMAT, from 1 to the 
number of regions in the structure. 

P - Counts the load steps in the analysis. 

The block data and overlay listings are included in this section. 
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RUN, //T STARSS* 1HNTS V440063* KEYJ0HBIN214, 05*500 
ASG.T PUR, T , S AVE05 
FREE TPFS. 

ASG.T TPF$,F/1/P0S/10 
FOR, IS BLOATA, BLDATA 

BLOCK DATA lOOOIO 

COMMON /NAM1/ FACE! 4) , STRGO (7) , THERM (4 > , MATER 13) , SEG TABU2 ) 100020 

COMMON /GINT/ AA ( 8, 4) , WWt 8 , 4 I 100030 

DIMENSION A( 32 ) , W( 32 ) 100040 

EQUIVALENCE ( A(l) ,AA( 1, 1 ) ) , (Mil) ,MW< 1, 1 )) 100050 

DATA STRGO / 1 1 .0, 13 .0, 2 1 .0, 31 .0, 12.0, 14.0, 15.0/ 100060 

OATA THERM /4HTHST,4HN0TH,4HTHCN,4HTHIN/ 100070 

DATA MATER /4HI SOT, 4H0RTH, 4HST IF/ 100080 

DATA SEGTAB/4HST10.4HTH IC «4HRWAF , 4HRWA1 , 4HRWA2 , 4HRWA 3, 4H ISG1 , 100090 

1 4HISG2,4HISG3,4HST11,4HST12,4HST13/ 100100 

DATA FACE /4HSING.4HEQUA, 4HUNEQ, 4HBLAN/ 100110 

DATA A/0.0,.57735027, .77459667, . 861 1363 1 , .90617984,. 93246951, 100120 

0 .94910791,. 96028986, 0.0, 0.0, 0.0,. 33998 104, .53846931 ,.66120939, 100130 

A .741531 18,. 79666648, 0.0, 0.0, 0.0, 0.0, 0.0,. 23861 919, .40584515, 100140 

T .52553241,0.0,0.0,0.0,0.0,0.0,0.0, .40584515, .18343464/ 100150 

C 100160 

DATA W/0. 0,1.0, .55555556, .34785484, .23692688, .17132449, .12948497, 100170 

D . 10122854,0.0,0.0, .88888889, .65214515, .47862867, . 36 076157, 100180 

A .27970539,. 22238100, 0.0, 0.0, 0.0, 0.0,. 56888889, .46791393, 100190 

T .3818300,. 3 1370664, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,. 41 79591 8, .36268378/ 100200 

END 100210 
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FOR, IS MAIN, MAIN 

C ROUTINE **MA INPROG** ABACUS UPDATED 01/11/74 

' INTEGER SAVJTC.SAVSTP.SEGTAB, Q .THICK, TYPE 
INTEGER XNl.XN 

COMMON STORY(16l,XMAT(270,lO),STD(lO),SAOUS(3OI,RADUS(3O) 

COMMON T ADUS (30 1 , UADUS ( 30 ) , SAVTIC ( 900) 

COMMON XN, TEFREE, TIC, PHI, STOP, RESTOP, RT ICK ,G1 , XNL I 3) ,NH 
COMMON NST(30),NKL(30),NXMATI20> ,SAVJTC 130) , SA VSTP 130 ) , JRTIC f 30) 
COMMON JRST0PI30) ,NREG, NMPT ,NRC , NSC .I'll X , IERROR , KGEOM , IGEOM, I STTAB 
COMMON KELVIN, IBEGIN,NPROB,NSEG,NERROR,Q, THICK, NOJS, NL INKS .NLCASE 
COMMON NTSKL.NZ, NBC T,L INPUT, NTRKL.NPASS , XN1 ,KBC , NR INGS 
COMMON LODE, ICYCLE , LO ISTL 

COMMON /NAM1/ F ACE( 4 1 , STRGO (7) .THERM (4) .MATER <31 .SEGTABC 12 ) 

COMMON /LYCORR/ YC0RRI80) 

COMMON /ARING/ NR ING< 28 ) , AMAT I 30, 8 ) ,RS IGI 12 1 ,REPS< 12 ) .RALPH! 12 ) , 

C RBAPHI12) 

COMMON /PLS/ OMEGA, IWORD.XMERD.XPRES.XMONT 
COMMON /PLSTIC/ 10, JO, IOR , JOR ,KOR I , NEO 
COMMON /CDISP/ P, IMAX,DELP,DELP1,YEPS,ZEPS 

COMMON /GRAF IX/ X< 100 I , Y 1 100, 9 1 , NGRAPH »LDEF ( 9) , NGR ,J CYC, NFLAG, JAM, 
C JNSC 

DIMENSION WORD! 3 ) 

DATA WORO/'PLASS'NLIN'.’NLPL'/ 

REWIND 1 
REWIND 2 
REWIND 3 
REWIND 4 
REWIND 8 
REWIND 9 
REWIND 10 
REWIND 11 
REWIND 12 
REWIND 13 
REWIND 14 
REWIND 15 
YEPS = 0.999 
ZEPS = YEPS-1.0 
NCUPLE = 1 
NPROB = 1 
NGP = 1 

NLCASE = NPROB 
JUSRN = 28 
KDSRN = 23 
NFLAG = 0 
111 WR ITE ( 6, 1726 ) 

1726 FORMAT I 1 H 1 > 

READ(5,1000,END=555J STOkY 

1000 FORMAT I.16A4) 

LODE = 1 

ICT = 0 
NH = 0 
XN = 0 
NIX = 0 
0=5 

LDISTL = 5 
DO 100 J=1 ,3 
100 XNL ( J ) = 0.0 

READ! 5, 10011 NREG.NSMAX , NMPT, LINPUT ,NLDS , CYC 1 ,CYCP,NLR ,RCYC , PRES , 

1 IW0R0,0MEGA,AW0R0,NX3,LDEF,CYCG 

1001 FORMAT ( 12, 13,312, F6.0.F4.0, 1 2 , 4X , 2F6.0 , 17X, I 2, E 14. 7/ A4 , 1 6 , 10X.91 1 , 
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200610 


1 2X.F6.0) 

HR ITE ( 6 1 602 ) NSMAX, NREG, NMPT, CYC 1 

602 FORMAT ( / / // 19X»93HUNSYMMETRIC» ORTHOTROPIC, REINFORCED SHELL ANALY 
ISIS WITH COUPLING OF AT MOST 29 SHELL REGION S« //62X, • STARS-2P • ,// 
262X, 

3 • AS OF JULY 1, 1973*////8X,21HNUMBER OF SEGMENTS = . I3.21H NUMBER 
60F REGIONS = .I2.63H NUMBER OF MATERIAL PROPERTY TABLES USED = ,12 
5 , 17H NO. OF CYCLES = ,F6.0> 

DO 115 J = l* 3 

115 IF (HORD(J).EQ.AHORO) GO TO 106 
STOP 

106 JPLS = J 

GO TO (615, 616,617), JPLS 

615 HR ITE ( 6,618 ) 

61B FORMAT ( ///55X, • ELASTIC-PLASTIC PROBLEM* I 
GO TO 621 

616 HRITE(6,619) 

619 F0RMAT(///50X, 'LARGE DEFLECTION ELASTIC PROBLEM*) 

GO TO 621 

617 HR ITE (6,620 ) 

620 F0RMAT(///50X, 'LARGE DEFLECTION PLASTIC PROBLEM*) 

621 CONTINUE 
HRITE (6, 625 1 

625 FORMAT!///) 

HR ITE (6, 605 ) ( STORY! I ) , 1=1 , 16 J 

605 FORMAT (11(/) »8X, 16A6, 18 ( / ) , BOX, 35HFOR INFORMATION CALL V. SVALBO 
INAS/117X,16H(516) 575-7701/103X , 10HP . OGILVI E//103X, 9HH. LEVINE) 
NGRAPH =0 
00 700 J=1 ,9 

700 IF (LDEF( JI.NE.O) NGRAPH » NGRAPH+1 
NGR = 0 
NEO = 0 

IF (PRES. NE. 0.0) NEO = 1 
IF (NEO.EQ.O) GO TO 300 
IF (JPLS.GT.l) XNL(l) = 1.0 
IF ( JPLS .NE . 2 ) XNLI 2 ) = 1.0 
^-IF (NX3.EQ.1) XNL ( 3 ) = -1.0 
300 10 = 13 

JO = JDSRN-I 0 

IOR = 11 

P = PRES 

OELP = 1.0/CYC1 

DELP1 = OELP 

OMEGA = OMEGA*OMEGA 

NMAT = 1 

IF (CYCP.EO.O.O ) CYCP = 1.0 
IF (NLR.LE.l) GO TO 121 
LODE = 16 
REWIND LODE 
121 CONTINUE 
NR OH = 0 
ICT = ICT+1 
ICYCLE = 0 

IF (ICT.EQ.l) ICYCLE = RCYC 
ICYC1 * ABS(CYCl) 

IMAX = ICYC1 
IF (NMAT.EQ.O) GO TO 1 

KK=-r 

NSAVE=0 

DO 13 1=1, NMPT 
KK=KK+2 
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NXMAT(KK )=NROW+l 201220 

1 1 =NR0W+ 1 201230 

RE ADC 5 « 1004 ) STD(I),TYPE 201240 

1004 FORMAT ( A4, 6X, A4, 6X ) 201250 

NROW = 27 201260 

DO 11 L=l,3 201270 

11 IFCTYPE.EQ.MATERCL ) ) GOTO 12 201280 

GO TO 8000 201290 

12 CONTINUE 201300 

IF (L.EO.l) NROW - 7 201310 

IF (L.EQ.2) NROW =17 201320 

LLL=NSAVE+NROW 201330 

READ (5,1005) ( ( XMATC M, J ) , J=1 , 10) ,M= II , LLL ) 201340 

1005 FORMAT (5E14.7) 201350 


NROW=NS AVE+NROW 
NX MAT ( KK+l ) =LLL 
13 NS AVE=NROW 
READ(5»2000 ) 

2000 FORMAT (IX) 

1 CONTINUE 
P = P+1.0 
ICYCLE = I CYCLE*- 1 
NGR = 0 

IF (P.NE.CYCG*NGP) GO TO 10 
NGR = 1 
NGP = NGP+1 
10 CONTINUE 
C = ICYCLE 
IBEGIN = 0 
N = C/CYCP 
PP = N*CYCP 

IF ( ( C. EQ. 1.0. OR. C.EQ.PP. OR. ICYCLE. EQ. ICYC1 .OR.NH. EQ .0 ) . AND. 

1 LI NPUT .EQ. 1 ) IBEGIN * 1 
JOR * KDSRN-IOR 
DO 99 NRC= 1, NREG 

IF (NH. EO.O. OR. IBEGIN. EQ.ll WR ITE(6, 1726 ) 

IF (Q.EQ.5) READ( 5 , 1003 ) NSTINRC ) »NKL ( NRC ) , NRINGINRC ), STORY 
1003 FORMAT! 312, 16A4) 

IF (NH.NE.O) GO TO 613 

WR I TE ( 6 , 606 ) NRC , NST ( NRC ) ,NKL( NRC ) 

606 FORMAT (////////////////////// ///58X, 13HREGI0N NUMBER , I3//35X,10HTH 
1ERE ARE ,12, 14H SEGMENTS AND ,I2,35H KINEMATIC LINKS WITHIN THIS R 
2EGI0N) 

GO TO 610 

613 IF (IBEGIN. EO.O) GO TO 610 

WRITE (6,612) NRC , NST ( NRC ) ,NKL (NRC ) 

612 FORMAT! ///58X.13HREGI0N NUMBER , I 3//35X, 10HTHERE ARE ,I2,14H SEGMEN 
ITS AND , 1 2 , 35H KINEMATIC LINKS WITHIN THIS REGION) 

610 CONTINUE 

IF (Q.EQ.5 ) REAO ( 5, 1006 ) JR TIC (NRC ) , JRSTOP (NRC f ,STOR Y 
1006 FORMAT (5X,2I5,16A4) 

NSEG = NST ( NRC ) 

201 NSC=0 
101 NSC=NSC+ 1 

IF (NH. EQ.O. OR. IBEGIN. EQ.l) WRITEI6, 1726) 

CALL RIEMAN 

IF (NIX.NE.O) GOTO 8888 
CALL SEGMAT 

IF (NIX.NE.O) GOTO 8888 
IF (NSC.LT .NSEG) GO TO 101 
NSC= 0 
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102 CALL REGHAT 
IFINIX.LT. 0) GO TO 8888 
NIX => 0 

REWIND 2 
REWIND 3 
99 CONTINUE 

IF (C.EQ.l.O.OR.C.EQ.PP.OR.ICYCLE.EQ.ICYCl.OR.NH.EQ.O) IBEGIN 

103 CALL STRHAT 

IF (NIX.NE.O) GOTO 8888 
REWIND 1 

105 CALL INITAL 
REWIND 10 
REWIND JO 
REWIND LODE 
CALL" LEBEGE 
REWIND IOR 
REWIND JOR 
10 = JDSRN-IO 
JO = JDSRN-IO 
REWIND 10 
REWIND JO 
IOR = KDSRN-IOR 
Q = 1 
REWIND 1 
REWIND 2 
REWIND 3 
REWIND A 
REWIND 8 
REWIND 9 
REWIND 10 
REWIND 11 
REWIND 12 
REWIND 13 
REWIND 14 
REWIND 15 
REWIND LODE 
JCYC = P 

WR ITE 16* 2500 ) JCYC, ICYCLE 
2500 F0RHATI/5X, ' CYCLE* , I5, , , , ,I5,' IS COMPLETE. •> 

IF ( ICYCLE .NE. 1 .AND.NH.NE.O) GO TO 112 
NH = 1 

DELP1 = DELP 
LDISTL = 1 
112 CONTINUE 

IF (JPLS.GT.il XNL( 1 1 = 1.0 
IF I JPLS.NE.2) XNL( 2) = 1.0 
IF (NX3.EQ.il XNL (31 = -1.0 
IF (NIX.NE.O) GO TO 8888 
IF ( ICYCLE. EQ.ICYCl) GO TO 556 
GO TO l 

556 IF (NLDS.LE. ICT I GO TO ill 

REA0( 5, 1010 1 L INPUT, CYC1 tCYCPfLO I STL ,NHAT, OMEGA 
1010 FORMAT (7 X, I2,2X,F6.0,F4.0,2X,2I2,31X,E14.7) 

DELP = 1.0/CYC1 
IF (LDISTL. EQ.O) LDISTL * l 
OMEGA * OMEGA*OMEGA 
GO TO 121 

555 IF (NGRAPH.NE.O I CALL ENOJOB 
STOP 

8000 IERR0R=8000 
NERROR= 1 
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MAP, IS SYM, STARSS 
LIB SYS$*MSFCS. 

SEG ROOT 
IN NBF24* 

IN MAIN , BLOAT A 
SEG RIE*. (ROOT) 

IN RIEMAN, SETUP, ROBOT, GEOMET.PL INE.PLICO 
SEG OF 1* , (RIE ) 

IN DIF1 

SEG DF2*» (RIE ) 

IN OIFF2 

SEG SGHAT*, (ROOT) 

IN SEGMAT,SREVN2 
SEG RING*, ( ROOT) 

IN RINGER.RISULT , R ITEPS, RGSRSE , SYMSOC, BANDIT ,LLTRAN,TRI SLV ,HCTDOT 
SEG REG*, (RING ) 

IN REGMAT 
SEG STR* , (RING ) 

IN STRHAT 
SEG INI*, (ROOT I 
IN INI TAL 
SEG LEB* , ( ROOT ) 

IN LEBEGE, FIXER, T08AR, TEMOEG.PL YNE,PLYCO 
SEG 001*, (LEB) 

IN 00E1 

SEG 002*, (LEB) 

IN 00E2 

SEG TRAP*, (ROOT) 

IN ETRAP 

COPOUT TPF$. , PUR. 

XQT STARSS 
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SUBROUTINE RIEMAN 


This subroutine link assembles the data tables for use in the integration 
procedure. The subprogram link, RIEMAN, utilizes the subroutines SETUP, 
ROBOT, DIF1 or DIFF2, to integrate the differential equations of each 
segment independently, under arbitrary load, conditions. The results of 
the integrations of each segment are stored in the YCORR array in RIEMAN, 
and represent the stiffness and deflection coefficients of each segment. 
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FORTRAN CODE 

ENGINEERING SYMBOLS (REF. 1) 

XFTHLD 

f e 

XFPHLD 

f $ 

XFZELD 

f 


c 

XMTHLD 

m e 

XMPHLD 

% 

ETHET 

E 0 

EPHI 

E <l> 

XGPT 

G 


4>0 

XNUTP 

v e<t> 

XNUPT 

v <j>0 

ALPHTH 

“0 

ALPHPH 

% 

XNTTH 

N T0 

XNTPH 

% 

XMTTH 

^0 

XMTPH 

“t* 

XK11 

K_, 


11 

XK22 

K 


22 

XD11 

D..., 


11 

XD22 



22 

XK33 

K 33 

XD33 

D 33 

- 
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RIEMAN 
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FOR, IS RI EMAN, RI EMAN 

C ROUTINE ** RIEHAN ** ABACUS UPDATED 01/11/74 

SUBROUTINE RIEHAN 

INTEGER SAVJTC, SAVSTP, SEGTAB, Q .THICK, TYPE 
INTEGER XN 

DOUBLE PRECISION YNEW , YPRED 

COMMON STORY! 16) ,XHAT( 270, 10), STD! 10) , SADUS! 30) ,RADUS(30) 

COMMON TAOUS! 30 ) , UADUS ( 30 ) , SA VTIC ( 900 )• 

COMMON XN.TEFREE, TIC, PHI, STOP, RESTOP, RT ICK ,G1 ,XNL ( 3) ,NH 
COMMON NST!30),NKL( 30 ), NXMAT! 20 ), SAVJTC! 30 ), SAVSTP <3 0) ,JRTIC!30) 
COMMON JRST0P(30),NREG,NMPT»NRC,NSC,NIX, IERROR ,.KGEOM , I GEOM, I STTAB 
COMMON KELVI N, I BEGI N.NPROB, NSEG.NERROR ,0 , THICK, NOJS, NL INKS, NLCASE 
COMMON NTSKL,NZ,NBCT,LINPUT,NTRKL,NRASS, N 1 , KBC »NR INGS 
COMMON LODE, ICYCLE, LO ISTL ' • 

COMMON /NAM1/ FACE( 4) , STRGO! 7 ) , THERM (4 ) ,MA.TER( 3 ) , SES TAB! 12 ) 

COMMON /LYCORR/ YC0RRI72) t : . 

COMMON /MAGIK/ KKNT ; 

COMMON / EQUAZN/ YPRED! 72 ) , YDOT ! 72 ( , YASAVE! 72 ) , 

1 YANTH,YAMTH,YAMPT,YAJPH, 

2 S,SN,CS,SNSQ,CSSQ,TAN,SEC,CN,X1CS,X1SN,TN, 

3 X1RO,X1ROSQ,X1SNRO,X1CSRO,CN1RO,SN1RO,CS1RO, 

4 X1R1,X1R2,CS1R1,CS1R2,SN1R1,X1R1SQ,R2SQ,R0,BESQ, 

5 ROSQ, XNSQ, BETA, R 1,R 2, S1,R1D0T, 

6 XNTTH,XNTPH,XMTTH,XMTPH,XFTHLD,XFPHLD,XFZELD, 

7 XHTHLD,XMPHLO,ETHET,EPHI,XGPT,ALPHTH , ALPHPH , ’ 

8 ' XNUTP, XNUPT, XC 11,XC22,XC15,XD33, XD22 , XD2 1 , XD12 , 

9 XK 1 1 , XK 12* XK2 1 « XK22 ,XK33 ,XD1 1 ,' 1 

A XNPHI.H, I,BETTA,ZETTA,XC16 

COMMON /SPLINS/ ANG, PSI ( 100 ) ,R AD! 100) ,CUR1 1 100 ) ,CUR2 ! 100 ) , 

1 DRlDP(100)«ZI(14),RIil4),NRZIN 

COMMON /ARING/ NRING ! 28 ) , AMAT I 30 ,8 ) ,RSIG 1 12 ) .REPS ( 12 ) .RALPH ! 12 ) , 

C RBAPH! 12 ) 

COMMON /PLS/ OMEGA, IUORO, XMERO.XPRES.XMONT 
COMMON /PLSTIC/ 10, JO, IOR, JOR.KORI ,NEO 

COMMON /WOOD/ SAVY(53),NPLEV,NLP0,NPLA(21),STR!6) .SIGMA! 3,21), 

C SEPS!3i21),SALPH!3,21),SBAPH!3,21),STEPSI3,21), 

0 EFF!21),STSRN(3 )', NPL AST l 3)»STSIG!3) STSTREPS ( 3 ) ,' 

M STALPH!3),STBAPH!3),EFFST!3) , NPLE VS! 3) 

COMMON /CHAIN/ ZETA 11 21 ) , ZETA2! 21 ) .NODE , ALF 14) ,CEI4) .NLRS.HI ,H0, T 
DIMENSION LSTI13) , YDEV1 72 ) , YICS ! 72 ) , YNEW ! 72 ) 

DIMENSION TBDEL172) .FWDELI72) 

DIMENSION ST (30, 31), XL AYER (26), HARD! 3) 

DATA HARD/ • I SOT •, • K INE • » ' PERF * / 

DATA APEX1/ • APEX • / 

1726 FORMAT (1 HI) 

IF(Q.EQ.l) GO TO 191 

RE AD! 5, 1001 ) RGO, ANG, NLRS, STORY 

1001 FORMAT (F2«0,A1, 12, 16 A4) * - 

C GEOMETRY IDENTIFICATION SEARCH " - ‘ 

DO 504 1=1,7 

IF 1 RGO-STRGO 1 1 ) J 504,505,504 
504 CONTINUE 
GOTO 8086 


505 KGEOM=I 

I GEOM = 0 

IF (KGEOM.EQ.1.0R.KGE0M.EQ.2.OR.KGEOM.EQ.5.OR.KGEOM.EQ.6) IGEOM =1 
IF (KGE0M.EQ.3) IGE0M=2 
IF(KGE0M.EQ.4) IGE0M=3 
IF ( KGE0M.EQ.7 ) IGEOM = 1 
WRITE(l) KGEOM, IGEOM, RGO, ANG, NLRS, STORY 
READ! 5, 1002 ) OTAU.DIFF, STEP, APEX 
1002 FORMAT (3E14.1,3X,A4) 


300000 
300010 
300020 
300030 
300040 
300050 
300060 
300070 
300080 
300090 
300100 
300110 
300120 
300130 
300140 
300150 
300 i60 
300170 
300180 
300190 
300200 
300210 
300220 
300230 
300240 
300250 
300260 
300270 
300280 
300290 
300300 
300310 
300320 
300330 
300340 
300350 
300360 
300370 
300380 
300390 
300400 
300410 
300420 
300430 
300440 
300450 
300460 
300470 
300480 
300490 
300500 
300510 
300520 
300530 
300540 
300550 
300560 
300570 
300580 
300590 
300600 


113 



NAPEX = 0 

IF ( APEX .EQ. APEX 1 ) NAPEX >1 
DELTA =0.0 

WRITE! 1) DTAU.DIFF, STEP, DELTA, NAPEX 
IF (RG0.EQ.14.0) GO TO 180 
READ! 5, 1006) G1,G2,G3 
1006 FORMAT (3E14.1) 

WRITE(l) G1.G2.G3 

GO TO 481 

180 READ! 5, 198 ) NRZ IN, 1 21 1 J ) ,RI 1 J I , J»l,NRZIN » 

198 FORMAT (I2«7F10.0/7F10.0) 

WRITE (1) NRZ IN, (Z1I J),RI( J ) , J=1,NRZ IN) 

481 CONTINUE 

READ! 5, 1003 ) TYPE.HL AYR, SHEET, INTERP, RANKIN, HARDEN, NP 
1003 FORMAT ( 6 (A4, 6X ) • 10X, 12 ) 

IFINP.LT. 2. OR. NP.GT. 301 GO TO 8787 
C MATERIAL PROPERTY IDENTIFICATION 
00 501 1=1 , NMPT 
IF (HLAYR-STDI 1 1 ) 501,502,501 

502 MAT=I 
GOTO 503 

501 CONTINUE 
GOTO 8036 

503 DO 506 1=1,3 

IF (TYPE-MATERC 1 1 ) 506,507,506 

506 CONTINUE 
GOTO 8087 

507 ITYPE=I 

DO 510 1=1,12 

IF ( INTERP-SEGTABIII 1510,511,510 

510 CONTINUE 
GO TO 8088 

511 I STTAB= I 

DO 508 1=1,4 

IF (SHEET. EO.FACEU)) GOTO 509 

508 CONTINUE 
GOTO 8089 

509 THICK=I 
KLUE2=1 

GO TO (430,430,420,420,420,420,425,425,425, 430,430, 430) , I STTAB 
420 KLUE2=2 
GO TO 430 
425 KLUE2=3 
430 KLUE1=THICK 

C TEMPERATURE LOAD IDENTIFICATION 

DO 401 1=1,4 

IF (RANKIN. EQ. THERM(I) (GOTO 402 

401 CONTINUE 
GOTO 8090 

402 KELVIN=I 

C LINEAR ANALYSIS IDENTIFICATION 

IANLYZ = 1 
IWD = 1-IWORD 
NROW = 3-IWO 

IF (THICK. GT.l) NROW = THICK*3-2* IWO 
IF ( ISTTA8.EQ.1) NROW = 14-3* IWD 
IF ( ISTTAB.EQ.3) NROW = 16- 3* IWD 
IF ( ISTTAB.EQ.4I NROW = 10-2*IWD 
IF ( ISTTAB.EQ.5) NROW = 12-3*IWD 
IF ( ISTT AB.EQ.6) NROW = 13-3*IWD 
IF ( ISTT AB.EQ.7 ) NROW = 9-2*IWD 


300610 

300620 

300630 

300640 

300650 

300660 

300670 

300600 

300690 

300700 

300710 

300720 

300730 

300740 

300750 

300760 

300770 

300780 

300790 

300800 

300810 

300820 

300830 

300840 

300850 

300860 

300870 

300880 

300890 

300900 

300910 

300920 

300930 

300940 

300950 

300960 

300970 

300980 

300990 

301000 

301010 

301020 

301030 

301040 

301050 

3010$0 

301070 

301080 

301090 

301100 

301110 

301120 

301130 

301140 

301150 

301160 

301170 

301180 

301190 

301200 

301210 
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IF ( ISTTAB.EQ.8) NROW = 11-3*IWD 

IF ( ISTTA8.EQ.9) NROW = 12-3*IWD 

IF (ISTTAB.EQ.IO) NROW = 15-3*IWD 

IF (ISTTAB.EO.il) NROW = 17-4MWD 

IF ( ISTTA8.EQ.12) NROW = 18-4MWD 

IF (KELVIN. EQ. 2. OR. KELVIN. EQ. 4) GO TO 580 
IF ( ISTTAB.GE.10) GO TO 581 

IF ( ISTTAB.GE.4) NROW = NROW+1 

GO TO 580 
581 NROW = NROW+2 
580 CONTINUE 

TEFREE = 0.0 
DO 540 1 = 1,3 

IF (HAROEN-HARD( I ) ) 540,541,540 

541 KOR = I 
GO TO 542 

540 CONTINUE 

NERROR = 8013 
GO TO 8888 

542 IF (ITYPE. EQ.l) GO TO 550 
IF (KOR.GT.l) GO TO 551 
NERROR = 8008 

GO TO 8888 
551 KOR I = 1 
GO TO 553 
550 KOR I = -1 
. IF ( KOR. EQ. 1 ) KOR I = 0 
553 CONTINUE 

WRITE! 1 ) ITYPE, MAT, THICK, I STTAB,KELVIN,KORI , TEFREE ,NP,KLUE1 ,KLUE2, 
1 I ANLYZ , NROW 

GO TO 192 

191 READ(l) KGEOH, I GEOM.RGO, ANG.NLRS, STORY 
RE ADI 1 1 DTAU.DIFF, STEP, DELTA, NAPEX 

IF ( RGO.EQ. 14.0 I GO TO 182 
READ (1 ) G1,G2,G3 

GO TO 183 

182 READ! 1 ) NRZ IN, ( ZI ( J ) ,RI ( J ) , J=1 ,NRZ IN ) 

183 CONTINUE 

READ! 1) ITYPE, HAT, THICK, I STTAB, KELVIN, KOR I, TEFREE, NP ,KLUE1 ,KLUE2 , 

1 I ANLYZ, NROW 

192 EPSIL =1 .0E-05 
01 FF = 1 .0E-04 
ERR = 1.0 E-07 

IF (NH.NE.O) GO TO 920 
I = RGO 

WRITE (6, 651) NSC, I, STORY, DTAU.DIFF, STEP, DELTA 

651 F0RMAT(//13X,15HSEGMENT NUMBER , 12, 5X, 13HSE GHENT CODE ,I2,5X, 

1 16A4//22X ,4HDT AU, 1 5X, 4HD IFF 

2,1 5X, 4HSTEP , 10X , 5HDEL TA//16X,5(E14.7,5X),2X,F2.0) 

IF (RGO.EQ. 14.0) GO TO 185 
WR ITE ( 6, 652 ) G1.G2.G3 

652 FORMAT ( //54X.24HGE0HETRY INPUT VAR I ABLES , //38X, 3 ( E 14 . 7 ,5X ) ) 

. GO TO 645 

185 WRITE (6,186) ( Z I < I ) ,R I ( I ) , 1=1, NRZ IN ) 

186 F0RMATI//57X, 24HGE0METRY INPUT VAR I ABLES//42X, 1 6HAXI AL COORDINATE, 

1 9X.6HRA0IUS/50X, 1HZ.20X, 1HR/ ( 43X , 1P1E 15. 8,5X, 1P1E15.8)) 

645 WR I TE ( 6 , 653 ) TYPE, HLAYR, SHEET, INTERP, RANKIN, HARDEN, NP 

653 FORMAT (//12X,5(A4,6X),16HHAR0EN ING LAW = ,A4,12X, 

1 26HNUHBER OF TABLE COLUMNS = ,12) 

920 CONTINUE 

L= 2+( MAT-1 ) ■*•! 

I I=NXMAT (L ) 


301220 

301230 

301240 

301250 

301260 

301270 

301280 

301290 

301300 

301310 

301320 

301330 

301340 

301350 

301360 

301370 

301380 

301390 

301400 

301410 

301420 

301430 

301440 

301450 

301460 

301470 

301480 

301490 

301500 

301510 

301520 

301530 

301540 

301550 

301560 

301570 

301580 

301590 

301600 

301610 

301620 

301630 

301640 

301650 

301660 

301670 

301680 

301690 

301700 

301710 

301720 

301730 

301740 

301750 

301760 

301770 

301780 

301790 

301800 

301810 

301820 

301830 
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1 1 I=NXMAT (L + l ) 301840 

IF ( NH. NE .0 ) GO TO 921 301850 

WRITE (6,654 ) ( C XMAT ( I, J ) , J = 1 , 10 ) , 1 = 1 1 , 1 1 1) 301860 

654 FORMAT ( / /51X « 28HMATER l AL PROPERTY TABLE USED, //I10I1H ,E12. 5)1) 301870 

WRITE(6,655) 301880 

655 F0RMAT(//42X, 47HT ABLE ORDER PHI OR S VS. CROSSECTION PROPERTIES,) 301890 

921 CONTINUE 301900 

00 901- I=1,NR0W 301910 

IF(Q.EQ.l) GO TO 193 301920 

READ 15,1005) ( ST ( I , J ) , J = 1 , NP ) 301930 

1005 FORMAT (5E14.7) 301940 

WRITE! 1 ) ($T(I*J)»J=1*NP) 301950 

IF (NH.NE.O) GO TO 901 ■ 301960 

194 WRITE(6,600) ( ST ( I, J),J=1,NP) 301970 

600 FORMAT ( 1H , 8TE14.7, 2X )/( 3X, 81 E 14. 7, 2X) ) ) 301980 

GO TO 901 , . - - 301990 

193 READ <1 ) ( ST! I , J ) , J = 1,NP ) 302000 

901 CONTINUE \ . 302010 

DO 750 JJ=1,12 302020 

750 LSTUJ) = 0 .. 302030 

NLCS = NLCASE 302040 

NLPO = NLRS+1 302050 

KBC = NLPO 302060 

IF (THICK. NE.t) KBC “ 2.0*NLPO 302070 

TAPI = NLRS/2 302080 

DO 290 1=1, NLPO 302090 

TAP2 = 1-1 302100 

• ZETA11I) = 1.0-TAP2/TAP1 302110 

290 ZETA2 ! I ) = 1 .0-FLOAT 11-1.) /FLOAT! NLRS > 302120 

K=NR0W+1 302130 

JJ=1 302140 

JJJ=6 302150 

MM=1 302160 

DO 17 NLC=1,NLCS 302170 

JT = JJ ■ ' - 302180 

JTT= JJJ 302190 

L=0 302200 

IF ( LD I STL . EO. 1 ) GO TO 195 302210 

RE AD! 5 , 1004 ) !LST! J ) , J=J J, JJJ ) 302220 

1004 FORMAT (611) 302230 

WRITE! LODE ) ! LST 1 J ) , J=J J , JJ J ) 302240 

GO TO 196 302250 

195 READ! LODE ) ! LST ( J > , J=JJ , J J J ) 302260 

196 CONTINUE ' 302270 

' IFILST(JJ) >8031,19,20 302280 

20 L = LSTIJJ) 302290 

19 JJ=JJ+1 302300 

23 IF (LST( JJ) >8031,22,21 302310 

21 L=L+1 302320 

22 IFIJJ.EQ.JJJ ) GOTO 24 302330 

JJ=JJ+l 302340 

GOTO 23 302350 

' 24 IF (L.EQ.O ) GO TO 71 302360 

KK = K ♦ L - 1 302370 

DO 72 M=K,KK 302380 

IF (LDISTL.EQ.1 ) GO TO 197 302390 

READ (5,1005) ( ST 1 M, J ) , J = 1,NP ) 302400 

WRITE(LODE) (ST ( M, J ) » J = 1 ,NP ) 302410 

GO TO 72 302420 

197 READ! LODE ) ( ST! M , J ) , J = 1 , NP ) 302430 

72 CONTINUE 302440 
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656 


657 

660 


661 


1968 


662 

665 

71 


17 

590 


591 

2000 


2004 

2005 


73 


IF (LST(JT).EQ.O) GO TO 660 
LY = K 
KY = K 

KZ = KHST(1)-1 
K = KZ+1 

IF ( (CYCLE. NE.l .AND. NH.NE.O) GO TO 665 
MR ITE (6*656 ) 

FORMAT ( //45X ,42HT ABLE ORDER PHI OR S VS. TEMPERATURE LOADS*) 

DO 657 N=KY,KZ 

WRITE (6 * 600 ) (ST(N, J),J=1,NP) 

CONTINUE 

I F ( ( L-LST (JTI).EQ.O) GO TO 665 
IF (NH.NE.O) GO TO 665 
MRITE(6*661 ) NLC 

FORMAT (// 16X * 8HPR0BLEM > 12* 5X» 84HTABLE ORDER PHI OR S VS. DISTRIB 
1UTED LOAOS (F THETA* F PHI. F ZETA* M THETA, M PHI1, ) 

WRITE <6, 1968 ) ( LST ( J > , J = JT, JTT ) 

FORMAT ( 27H LOAD IDENTIFICATION CLUES *611/) 

00 662 N * K, KK 

WR ITE (6*600 ) (ST(N,J).J*1*NP) 

CONTINUE 

CONTINUE 

K » K + L - LST(JT) 

JJ=JJJ+1 

J J J= JJ+5 

MM=MM+1 

CONTINUE 

IF (Q.EQ.l ) GO TO 2004 

READ (5*591) IS.SAVJTCI IS) , SAVSTPt IS) • I STORY! I). I s 1, 16) 

FORMAT (3I5.16A4) 

RE ADI 5* 2000 ) 

FORMAT ( IX ) 

WRITE(l) IS.SAVJTCI IS),SAVSTP( IS). STORY 
GO TO 2005 

REAO(l) IS.SAVJTCI IS), SAVSTP(IS), STORY 
CONTINUE 

ITIC « SAVJTC(IS) 

ISTOP = SAVSTPI IS) 

JTIC = JRTIC(NRC) 

JSTOP = JRSTOPI NRC I 
TIC = ST ( 1* 1 ) 

STOP = ST(l.NP) 

NEQNS=64*8'*NPR0B 

DO 73 1=1, NEONS 

YICS( I )=0.0 

YI CS ( 5 ) =1.0 

Y ICS ( 14 ) =1 .0 

YICS(23)=1.0 

YICS ( 32 ) =1 .0 

Y ICS ( 33 ) =1 .0 

YICS(42)=1.0 

YICS(51)=1.0 

YICSI60 )=1.0 

NCYC=0 

KKNT = 0 

NSAVE=NROW 

IEND=0 

PRINT=TIC 

DTA=OTAU 

DTAU = 0 .DO 

IF (NH.NE.O. OR. NEO.NE.O) 

IRE ADI 10) SAVY 


302450 

302460 

302470 

302480 

302490 

302500 

302510 

302520 

302530 

302540 

302550 

302560 

302570 

302580 

302590 

302600 

302610 

302620 

302630 

302640 

3026S0 

302660 

302670 

302680 

302690 

302700 

302710 

302720 

302730 

302740 

302750 

302760 

302770 

302780 

302790 

302800 

302810 

302820 

302830 

302840 

302850 

302860 

302870 

302880 

302890 

302900 

302910 

302920 

302930 

302940 

302950 

302960 

302970 

302980 

302990 

303000 

303010 

303020 

303030 

303040 

303050 

303060 



o o 


2001 FORMAT! 1X.1P1E16.7, I5.1P6E16.7) 

59 CALL SETUP ( MAGIN, MAGOUT.T IC, STEP, NEQNS, DTAU.EPSIL .DELTA , ERR, TIME, 
IDT IME, YICS, YPREO, YCORR, YOOT , YNEW, YDEV.FMDEL • TBOEL l 

GOTO 61 

60 CALL MAGIC ( MAGIN, MAGOUT*TIC, STEP, NEQNS, DTAU.EPSIL, DELTA , ERR, TIME, 
IDT IME.YICS, YPRED, YCORR, YOOT, YNEM.YDEV.FWDEL .TBOEL) 

61 IFIMAGOUT.LE.O) GOTO 25 
IF(TIME.GT.STOP) GOTO 62 
IF (TIME. LT. STOP) GOTO 63 

64 I EN0*-1 
GOTO 67 

62 IF(TIME.LE.(STOP*DIFFI) GOTO 64 
GOTO 8001 

63 IF(ISTOP-DIFF).LE.TIME) GOTO 64 
IFHTIME+OTIMEI.GT.STOP) GOTO 65 
IF ( PRINT.GT.TIME I GOTO 66 
PRINT*TIHE*DTA 

67 CONTINUE 

I F t IEND.GT.O) GOTO 6002 
IF ( IEND.LT .0 ) GOTO 150 
66 CONTINUE 
MAGIN = 0 
GOTO 60 

65 DTIME=STOP-TIME 
DELTA = 0.00 
GOTO 67 

75 NCYC=NCYC*1 
MAGIN=-1 
. GOTO 60 
25 LT=0 

IF ( t NH. NE.O.OR.NEO.NE.O ) • AND.KKNT.EQ. 3 ) 

1READU0) SAVY 
JJ « NLCASE*6 
DO 15 J=1,JJ 
15 LT=LT+LST(J) 

296 NTOTAL = LT*NSAVE 
PHI*TIME 
ARG=PHI 
LL=NP+1 
DO 51 1=1, NP 
I F I ARG-ST (1,11) 52,55,51 
52 IF ( 1-1 ) 55,55,54 
51 CONTINUE 
I = NP 

GO TO 55 

54 DO 57 IK=2, NTOTAL 

57 ST(IK,LL! = STIIK,I-l)-*(ST(IKtI!-ST(IK,I-l))4( ARC- ST II ,1-111/1 ST II, I 
1 1-ST (1, l~l 1 1 

GOTO 80 

55 00 58 IK=2, NTOTAL 

58 ST(IK,LL)=STIIK,I) 

80 CONTINUE 

THE UPDATED INTERPOLATED VALUES OF THE MATERIAL PROPERTY COEFFIC 
IENTS ARE FOUND IN THE XMAT TABLE ANO STORED IN THE XLAYER ARRAY 
|_ * (MAT-1 1*2+1 
1 1 =NXMAT (L ) 

III = NXMAT ( L*1 I 
LL=NP*1 
L=NROW ♦ 1 
M=1 

GOTO (91, 92, 93, 93), KELVIN 


303070 

303080 

303090 

303100 


303120 

303130 

303140 

303150 

303160 

303170 

303180 

303190 

303200 

303210 

303220 

303230 

303240 

303250 

303260 

303270 

303280 

303290 

303300 

303310 

303320 

303330 

303340 

303350 

303360 

303370 

303380 

303390 

303400 

303410 

303420 

303430 

303440 

303450 

303460 

303470 

303480 

303490 

303500 

303510 

303520 

303530 

303540 

303550 

303560 

303570 

303580 

303590 

303600 

303610 

303620 

303630 

303640 

303650 

303660 
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91 ARG = )STlL,LL)*STlL*l,LL)*ST)L*2,LL)*STlL*3,LL))/4.0 
GOTO 94 

93 CONTINUE 

ARG = ST (NROW+l,LL) 

94 00 104 I = 2,10 

IF ( ARG-XMAT ( 1 1 , I ) ) 121,123,104 

121 IF (1-2) 8007,8007,124 

104 CONTINUE 
GOTO 8067 

123 L= I I+l 

DO 122 J=L,III 
XL AYER ( M ) = XMAT ( J, I ) 

122 M=M*1 
GOTO 111 

124 L=II+l 

DO 125 J=L» III 

XLAYER(M) = XMAT(J* I- l )♦( XMAT) J, I )-XMAT) J , 1-1 ))*) ARG-XMAT )II , I -l ) )/ 
1 ( XMAT ( 1 1 , 1 l-XHAT ( 1 1 , 1-1 ) ) 

125 M=M+1 
GOTO 111 

92 L = II ♦ 1 

00 922 J*>L, III 

XL AYER ( M ) = XMAT ( J , 1 ) 

922 M=M+1 
111 CONTINUE 

115 GO T0(101«102«103), I TYPE 

101 ETHET * XLAYER(l) 

XNUTP = XL AYER) 2 ) 

ALPHTH = XL AYER ( 3 ) 

6PHI = ETHET 
XNUPT= XNUTP 
ALPHPH • ALPHTH 

XGPT = ETHET/I2.0*) l.O+XNUPT) ) 

N = 4 
GO TO 105 

102 ETHET = XLAYER(l) 

EPH1 = XLAYERC2) 

XNUTP = XLAYER13) 

ALPHTH = XLAYER) 4 ) 

ALPHPH = XLAYER) 5) 

XGPT = XLAYER)6) 

XNUPT = ETHET*XNUTP/EPHI 
N = 7 
GO TO 105 

103 ETHET = XLAYER) l ) 

EPHI = XLAYER) 2 ) 

XNUTP= XLAYER) 3) 

ALPHTH = XLAYER) 4) 

ALPHPH = XLAYER) 5) 

XGPT = XL AYER)6 ) 

ER = XLAYER) 17) 

ES =* XLAYER) 18) 

ALPHR = XLAYER) 19) 

ALPHS = XLAYER) 20) 

SIGOXR*XLAYER)23) 

SIG0XS=XLAYER)26) 

XNUPT = ETHET*XNUTP/EPHI 
N = 7 

105 CONTINUE 

SIGOX = XLAYER) N+2 ) 

CALL ROBOT ( ST,KLUE2,NR0M, LL, ER, ES, G2,G3,TIME, I TIC ,J TIC, NCYC , 

1 SIGOX, ALPHR, ALPHS, SIGOXR,SIGOXS) 


303670 

303680 

303690 

303700 

303710 

303720 

303730 

303740 

303750 

303760 

303770 

303780 

303790 

303800 

303810 

303820 

303830 

303840 

303850 

303860 

303870 

303880 

303890 

303900 

303910 

303920 

303930 

303940 

303950 

303960 

303970 

303980 

303990 

304000 

304010 

304020 

304030 

304040 

304050 

304060 

304070 

304080 

304090 

304100 

304110 

304120 

304130 

304140 

304150 

304160 

304170 

304180 

304190 

304200 


304210 

304220 

304230 

304240 

304250 
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IF (NIX.NE.0 1 60 TO 9999 

304270 

COMPUTATION OF K AND D FOR K AND 0 INPUT 

304280 

LL=NP*1 

304290 

IFIXKU.EQ.O.O) GOTO 8101 

304300 

IFIITYPE.EQ.3.AND.XK12.EQ.0.) GO TO 8102 

304310 

IFIITYPE.EQ.3.AN0.XK21.EQ.0.) GO TO 8103 

304320 

IFIXK22.EQ.0.0) GOTO 8104 

304330 

IFIXK33.EQ.0.0) GOTO 8105 

304340 

IFIXOU.EQ.O.O) GOTO 8106 

304350 

IFIITYPE.EQ.3.AND.X012.EQ.0.) GO TO 8107 

304360 

IF(1TYPE.EQ.3.AND.X021.EQ.0.) GO TO 8108 

304370 

IFIX022.EQ.0.0) GOTO 8109 

304380 

IFIXD33.EQ.0.0) GOTO 8110 

304390 

NL=0 

304400 

XSAVE1 = XNTTH 

304410 

XSAVE2 XNTPH 

304420 

XSAVE3 = XMTTH 

304430 

XSAVE4 = XNTPH 

304440 

XSAVE5 = XNLI2) 

304450 

XSAVE6 * XNLO) 

304460 

XNTTH = 0.0 

304470 

XNTPH * o.O 

304480 

XMTTH = 0.0 

304490 

XMTPH x 0.0 

304500 

XFTHLD=0.0 

304510 

XFPHLD*0.0 

304520 

XFZELD=0.0 

304530 

XMTHLD=0.0 

304540 

XMPHL0=0.0 

304550 

XNU2) x o.O 

304560 

XNLO) x o.O 

304570 

JFxe+NPROB 

304580 

K = NROW 

304590 

00 77 M*l, JF 

304600 

I = I M— 1 )*8 ♦ 1 

304610 

IF IM.LT.9) GOTO 49 

304620 

XNTTH = XSAVE1 

304630 

XNTPH x XSAVE2 

304640 

XMTTH x XSAVE3 

304650 

XMTPH x XSAVE4 

304660 

XNLO) x XSAVE5 

304670 

XNLO) x XSAVE6 

304680 

NL=NL+1 

304690 

XFTHLD x o.O 

304700 

XFPHLD = 0.0 

304710 

XFZELO = 0.0 

304720 

XMTHLO x o.O 

304730 

XMPHLO x 0.0 

304740 

I R“NL*6-5 

304750 

IFILSTI IRl.NE.O) K-K+LSTIIR) 

304760 

IF (LSTI IR+D.EQ.O) GOTO 44 

304770 

K=K*1 ' 

304780 

. XFTHLD*ST(K,LL) 

304790 

44 IFILSTI IR+2).EQ.O) GOTO 43 

304800 

K=K*l 

304810 

XFPHLD = STtKfLL) ♦XMERD* INORD 

304820 

45 IFIL$T(IR*3).EQ.0> GOTO 46 

304830 

KxK-*-1 

304840 

XFZELD = STIK.LD+XPRESMMORO 

304850 

46 IFILSTI IR44).EQ.O) GOTO 47 

304860 

RxK*1 

304870 
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XMTHLO = ST ( K, LL I ♦XNQNT* IWORD 

47 IF(LSTIIR+5).EQ.O) GOTO 48 . 

K=K+1 

XMPHLD=ST(K,LL> 

48 CONTINUE 

49 CONTINUE 

50 IF I ISTTA8.GE.3.AND. ISTTAB.LE.9) GO TO 4002 
CALL 0 IF I 

GO TO 77 

4002 CALL 0IFF2 

77 CONTINUE 
GOTO 75 

8001 IERROR=8001 
NERROR= 1 1 
GOTO 8888 

8002 IERROR=8002 
NERR0R=I2 
GOTO 8888 

8007 IERROR=8007 
NERR0R=15 
GOTO 8888 

8031 IERROR=8031 
NERROR= 9 
GOTO 8888 

8036 IERROR=8036 
NERROR= 2 
GOTO 8888 

8086 IERROR<=8086 
NERROR= 3 
GOTO 8888 

8087 I ERROR=8087 
NERROR= 4 
GOTO 8888 

8088 I ERR0R=8088 
NERROR=27 
GOTO 8888 

8089 I ERROR*8089 
NERROR= 5 
GOTO 8888 

8090 IERR0R=8090 
NERROR= 6 
GOTO 8888 

8067 IERROR= 8067 
NERROR= 16 
GOTO 8888 

8101 I ERROR = 8101 
NERR0R=17 
GOTO 8888 

8102 I ERROR = 8102 
NERR0R=18 
GOTO 8888 

8103 I ERROR = 8103 
NERROR= 19 
GOTO 8888 

8104 I ERROR = 8104 
NERROR=20 
GOTO 8888 

8105 I ERROR = 8105 
NERR0R=21 
GOTO 8888 

8106 I ERROR = 8106 
NERROR=22 


304880 

304890 

304900 

304910 

304920 

304930 

304940 

304950 

304960 

304970 

304980 

304990 

305000 

305010 

305020 

305030 

305040 

305050 

305060 

305070 

305080 

305090 

305100 

305110 

305120 

305130 

305140 

305150 

305160 

305170 

305180 

305190 

305200 

305210 

305220 

305230 

305240 

305250 

305260 

305270 

305280 

305290 

305300 

305310 

305320 

305330 

305340 

305350 

305360 

305370 

305380 

305390 

305400 

305410 

305420 

305430 

305440 

305450 

305460 

305470 

305480 

305490 
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GOTO 8888 

8107 I ERROR = 8107 
NERR0R=23 
GOTO 8888 

8108 I ERROR = 8108 
N£RR0R=24 
GOTO 8888 

8109 I ERROR = 8109 
NERR0R=25 
GOTO 8888 

8110 IERROR = 8110 
NE RR0R=26 
GOTO 8888 

8787 IERROR = 8787 
N£RR0R=34 

8888 NIX=1 
RETURN 

150 CONTINUE 

IF INH.NE.O) GO TO 925 
WRITEI6.670) 

670 FORMAT I / /46X *41HMATRIX X AND Y (TRANSPOSED) MAGIC OUTPUT) 
WRITE 1 6, 672) (YCORRII I, 1 = 1, NEONS) 

672 FORMAT (8I2X*E14.7) ) 

925 CONTINUE 
RESTOP=RO 
RADUSIISTOP) = RO 
TADUS I I STOP ) =R0 
GO TO I221,222,223),IGE0M 

221 SN = S IN ( PHI ) 

CS = COSIPHI ) 

GO TO 224 

222 SN = COSI 1.570796-G1J 
CS = SIN( 1.570796-G1) 

IF IG1.NE.0.0) GO TO 224 
SN = 0.0 
CS * 1.0 
GO TO 224 

223 SN = 1.0 
CS = 0.0 

224 CONTINUE 

AM AT ( I STOP , 1 ) = SAVYI22) 

AMAT ( ISTOP* 2 ) = SAVYI23) 

AMAT ( I STOP , 3 ) = SAVY ( 5 ) 

AMAT I ISTOP, 4 ) = SAVYI 1)*CS-SAVY(3)*SN 

IFINSC.LT. NSEG) GO TO 9999 

SADUS ( JSTOP ) = RO 

UADUS I JSTOP ) =R0 

AMAT I JSTOP, 5 ) = SAVYI 22 ) 

AMAT I JSTOP, 6 ) = SAVY ( 23 ) 

AMAT ( JSTOP, 7 ) = SAVYI5) 

AMAT! JSTOP, 8) = SAVYI 1)*CS-SAVY( 3 ) * SN 
IFIITIC.LE. ISTOP) GO TO 9999 
SADUSI JSTOP)=RADUSI ITIC) 

UADUSI JSTOP)=RAOUSI ITIC) 

9999 RETURN 
ENO 


305500 

305510 

305520 

305530 

305540 

305550 

305560 

305570 

305580 

305590 

305600 

305610 

305620 

305630 

305640 

305650 

305660 

305670 

305680 

305690 

305700 

305710 

305720 

305730 

305740 

305750 

305760 

305770 

305780 

305790 

305800 

305810 

305820 

305830 

305840 

305850 

305860 

305870 

305880 

305890 

305900 

305910 

305920 

305930 

305940 

305950 

305960 

305970 

305980 

305990 

306000 

306010 

306020 

306030 

306040 

306050 
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SUBROUTINE SETUP 


SETUP is a double entry subroutine called from RIEMAN. It is a mixed precision, 
numerical integration routine, with automatic selection of a variable integration 
step size, which utilizes fifth order Runge-Kutta equations to obtain the solution 
for first order differential equations. 

SUBROUTINE MAGIC 


MAGIC is an alternate entry point to subroutine SETUP. 
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ENTRY SETUP 
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FOR. IS SETUP. SETUP 

SUBROUTINE SETUP (MAGIN, MAGOUT, TIC, STEP, NEQNS.DTAU, 

1 EPSIL. DELTA, ERR, TINE, OTIME, YICS.YPRED, 

2 YCORR. YOOT ,YNEW, YDEV, FMDEL, TBDEL) 

DIMENSION VICSI 1 ) , YPREOI i ) .YCORR ( 1 ) , YOOTI II , YNENI 1 ), 

1 YOEVI l ),FMDEL( 1),TBDEL( 1) 

DIMENSION C(3),D(3I 
COMMON /MAG IK/ KKNT 
DOUBLE PRECISION YNEM.YPRED 
DATA C.D / .5, .5, 1.0, .5. .0,. 5/ 

TIME = TIC 
TAU * TIC 

IF (DELTA ) 200.201.200 

200 OTIME = 0.0078125 
GO TO 225 

201 DTIME = STEP 

225 DO 102 I * 1, NEONS 
YDEVin *0.0 
YPRED(I) * YICSCI) 

YCORR! I ) » YICS(I) 

102 YNEM(I) - YICS(I) 

MAGOUT =-2 
GO TO 264 

5555 CONTINUE 

ENTRY MAGIC (MAGIN, MAGOUT. TIC, STEP, NEONS, DTAU, 

1 EPSIL, DELTA, ERR, TIME, OTIME, YICS.YPRED, 

2 YCORR, YOOT, YNEM.YDEV.FHDEL.TBDEL) 

5556 CONTINUE 
MSET = 2 

IF (MAGOUT) 305,101,101 
101 IF (MAGIN) 21, 27, 14 
27 K « 0 

DO 202 I = 1, NEONS 

202 YNEM(I) * YPRED(I) 

21 K = K ,1 

KKNT = K 

210 DO 2 I - 1, NEONS 
GO TO (9,6,7 ,4, 11 ) ,K 
9 FMDEL ( I ) * YDOT(I) 

GO TO 105 

6 TBDEL(I) * YOOT ( I ) 

GO TO 105 

7 TBDEL(I) * TBDEL(I) YDOT(I) 

105 YPREOI I ) = YNEM(I) ♦ C( K )*DT IME*YDOT( I ) 

GO TO (2, 2, 400), K 
400 YCORR(I) = YPRED(I) 

2 CONTINUE 

TIME = TIME ♦ D(K)*OTIME 

99 MAGOUT = 0.0 

264 RETURN 

4 DO 8 I * 1, NEONS 

YPRED(I) * YNENI I ) ♦ DT IME* I FMDEL 1 1 ) ♦ 2.*TB0EL(I> *• YD0T(I))/6. 

8 YDEVII) = YCORR 1 1 ) - YPRED(I) 

GO TO 99 

11 IF IDELTAI80, 5,80 
Rf» DO 13 I * 1, NEONS 

IF IEPSIL* ABS I YCORRI I ) ) ♦ ERR - ABS I YDEVI I ) ) ) 14 , 13, 13 
13 CONTINUE 

IF ISIGBU5, 15,205 
205 SIGB * 0.0 
GO TO 5 
15 SIGB = 0.0 


400030 

400040 

400050 

400060 

400070 

400080 

400090 

400100 

400110 

400120 

400130 

400140 

400150 

400160 

400170 

400180 

400190 

400200 

400210 

400220 

400230 


400250 

400260 

400270 

400280 

400290 

400300 

400310 

400320 

400330 

400340 

400350 

400360 

400370 

400380 

400390 

400400 

400410 

400420 

400430 

400440 

400450 

400460 

400470 

400480 

400490 

400500 

400510 

400520 

400530 

400540 

400550 

400560 

400570 

400580 

400590 
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00 207 1 - l.NEQNS 

IF (ERR /100.* DELTA* ABS( YCORR (ID 

207 CONTINUE 

□TIME » 2.*0TIME 
5 00 208 I « lfNEQNS 

208 YCORR ( I ) - YPREO(I> 

305 IF (OTAU) 19*30,19 

19 IF (TAU - T I ME ) 20, 20* 27 

20 TAU » TAU ♦ OTAU 
30 MAGOUT =» 2 

GO TO 269 

14 DTIME » OTIME/2 .0 

25 IF (K-3148. 26,26 

26 TIME * TIME - DTIME - DTIME 
GO TO 47 

48 TIME - TIME - DTIME 
'47 SIGB = *2. 

DO 209 I » l.NEQNS 

209 YDOT(I» » FMOEL(I) 

212 K *> 0 

GO TO 21 
END 


400600 

ABS(YDEV(im 5,207,207 400610 

400620 

400630 

400640 

400650 

400660 

400670 

400680 

400690 

400700 

400710 

400720 

400730 

400740 

400750 

400760 

400770 

400780 

400790 

400800 

400810 
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SUBROUTINE ROBOT 


This subroutine is used by RIEMAN to calculate geometric and load co- 
efficients for use in the differential equations. With reference to 
geometry, all the necessary radii are calculated, as well as the stiff- 
ness coefficients of the various shell wall constructions. Thermal 
load moments and direct forces are calculated from direct temperature in- 
put. Inertia loads due to shell spin are also calculated. 

All the above values are passed back via the label common area EQUAZN. 

In the case of a special point input geometry the ROBOT routine calls 
GEOMET. 

Subroutines GEQMET, PLICO, PLINE 

Starting from a set of z,r points these subroutines calculate the necessary 
radii of the shell curves using spline fits. 
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FORTRAN CODE 

EUGHJEERING SYMBOLS (REF. 1) 

RO 

r o • 

R1 

r l 

R1DOT 

r l,4> 

CS 

COS <p. 

SN 

sin <p 

A 

a 

C 

c 

XN 

n . 

F2 

f 2 

F3 

f 3 

TAN; TN 

tan <p 

SEC 

sec 4> 

TII 

T. . 
11 

TIK 

T. 

ic 

TOK 

T ' 
oc 

TOO 

T 

oo 

TEFREE 

T 

HI 

h i 

HO 

h 

o 

T 

t 

TI 

t. 

l 

TO 

t 

o 

SNSQ 

sin*> 

CSSQ 

2 a 
COS <t> 

CN 

cos <£ sin 4> 

X1CS 

1/cos $ 

X1SN 

1/sin <p 

R2 

r 2 

BETA 

0 
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FORTRAN CODE 

ENGINEERING SYMBOLS (REF. 1 ) 

X1ROSN 

l/r Q sin <f> 

X1ROCS 

1/r cos <(, 

CSX1RO 

cos 4>/r Q 

CSX1R1 

cos 4>/r^ 

CSX1R2 

cos <|>/r 2 

SNX1RO ; 

sin <J>/r 0 

SNX1R1 

sin 4>/ 

X1R1 

l/r ! ' 

X1R2 

l/r 2 

X1R1SQ 

1 

1/r i 

X1ROSQ 

1/r o 2 
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ROBOT 


ENTRY 
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FOR, 


C 

C 

771 


S ROBOT, ROBOT 

SUBROUTINE ROBOT (ST,KLUE2,NROW,LL , ER, E S,G2, G3, TIME, ITIC , JTI C , 
NCYC, S1GOX, ALPHR.ALPHS.SIGOXR.SIGOXS) 

INTEGER SAVJTC, SAVSTP.Q, THICK 
INTEGER XN1.XN2.XN 
REAL*4 12 

OOUBLE PRECISION YPRED 

COMMON STORY (16), XM AT (270,10), STD( 10 ) , SADUS ( 30 ) ,RAOU S( 30 > 

COMMON TADUS(30 ),UA0US( 30I,SAVTIC< 900) 

COMMON XN, TEFREE, TIC, PHI .STOP, RESTOP, RTICK ,G1 ,XNL ( 3) »NH 
COMMON NST ( 30 ) , NKL (30),NXMAT(20), SAVJTC (30),SAVSTP(30) ,JRTIC(30) 
COMMON JRSTOP(30 ) ,NREG,NMPT,NRC, NSC , NI X , IERROR ,KGEOM , I GEOM, I STTAB 
COMMON KELVIN, I BEGIN, NPRGB,NS£G,NERROR,Q, THICK, NOJS.NL INKS, NLCASE 
COMMON NTSKL.NZ, NBCT.L INPUT, NTRKL.NP ASS, XNl.KBC, NR INGS 
COMMON LODE, ICYCLE, LDISTL 

COMMON /EQUAZN/ YPRED< 72 ) , YDOT ( 72 ) , YASAVE ( 72 ) , YANTH, YAMTH, 

YAMPT,YAJPH,S,SN,CS,SNSQ,CSSQ,TAN,SEC,CN,X1CS.X1SN,TN, 
X1RO,X1ROSQ,X1SNRO,X1CSRO,CN1RO, SN1R0.CS1R0, X1R1 ,X1R2, 

I CS1R1,CS1R2,SN1R1,X1R1S0, R2SQ.R0, BE SQ,RCSQ,XNSQ,BETA,R1 , 

• R2.S1.R1D0T, XNTTH, XNTPH, XMTTH,XMTPH,XFTHLD,XFPHLD,XFZELO, 

XMTHLD, XMPHLD, ETHET ,EPHI,XGPT , ALPHTH, ALPHPH, XNUTP.XNUPT, 
XC11,XC22,XC1S,X033,X022,XD21,X012,XK11 ,XK12 ,XK21,XK22. 
XK33,XD11,XNPHI,M,I,BETTA,ZETTA,XC16 
COMMON /SPLINS/ ANG, PS I ( 100 ) , R A0( 100 > , CUR 1 ( 100 > ,CUR2 ( 100 > , 

DR 1DP ( 100 ) , Z I ( 14 ) ,R I ( 14),NRZIN 

COMMON /ARING/ NR ING( 28 ) , AMAT ( 30 , 8 ) , RS IG ( 12 ) ,REPS( 12 ) , RALPH t 12), 
RBAPHI12) 

COMMON /PLS/ OMEGA, IMORD, XMERD, XPRES.XMONT 
COMMON /MAGIK/ KKNT 

COMMON /PLSTIC/ 10, JO, IOR, JOR.KORI ,NEO 

COMMON /HOOD/ S AVY( 53 ) ,NPLEV,NLPO,NPLA ( 21 ) , STR ( 6 ) , SI GMA ( 3 , 21 ) , 
SEPSl 3,21),SALPH(3,21),SBAPH(3,21),STEPS(3,21), 

I EFF(21),STSRN(3),NPLAST(3) ,STS IG ( 3 ) , STREPS ( 3 ) , 

I ST ALPH( 3 ) , STBAPH( 3)»EFFST(3),NPLEVS(3) 

COMMON /CHAIN/ ZETA 1 ( 21 ) ,ZE TA2( 21 ) .NODE , ALF ( A) ,CE ( AT ,NLRS,HI ,HO,T 
DIMENSION ST ( 30, 31 ) 

EQUIVALENCE ( SINB, SNB > , ( COSB.CSB I 
DATA A/'A •/ 

NCONT = NROW 

GOTO (771, 77 2, 773, 774,775, 776,7077 ) , KGEOM 
GEOMETRY FOR EL IPSE ( G3=0FFSET DISTANCE ) 

A = G1 
BE=G2 
BETA = BE 
BESQ=BE**2 
ASQ=A**2 
SN « SINIPHI ) 

CS = COS ( PHI ) 

SNSQ = SN**2 
CSSQ = CS**2 

R2 = A*SQRT ( 1.0/ ( SNSQ+BESQ*CSSQ ) ) 

R2SQ = R2**2 
R0=R2*SN 

R1=R2*R2SQ*BESQ/ASQ 

BESQ=BE**2 

R100T=0.0 

IF ( KGEOM. EQ.l. AND. BETA. NE. 1.0. AND. SN.NE. 0.0 ) R1D0T=3. 0*(R2*BETA/ 

A) **2*(CS/SNSQ)*(R1*SN-R0) 

I F ( SN. EQ • 0 .0 )G0 TO 779 
R2 = R2-G3/SN 
R2SQ = R2**2 


700010 

700020 

700030 

700040 

700050 

700060 

700070 

700080 

700090 

700100 

700110 

700120 

700130 

700140 

700150 

700160 

700170 

700180 

700190 

700200 

700210 

700220 

700230 

700240 

700250 

700260 

700270 

700280 

700290 

700300 

700310 

700320 

700330 

700340 

700350 

700360 

700370 

700380 

700390 

700400 

700410 

700420 

700430 

700440 

700450 

700460 

700470 

700480 

700490 

700500 

700510 

700520 

700530 

700540 

700550 

700560 

700570 

700580 

700590 

700600 

700610 
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RO = RO-G3 

700620 



GO TO 7775 

700630 


779 

IF (G3 .EQ. O.OJGO TO 7775 

700640 



R100T = 3.0*G3 

700650 



RO = -G3 

700660 



GO TO 7775 

700670 

c 


GEOMETRY FOR OGIVE 

700680 


772 

R1=G1 

700690 



C=G2 

700700 



SN = SINIPHI ) 

700710 



CS = COSIPHI ) 

700720 



IF ( SN.EC.O.O) GOTO 777 

700730 



R2=R1-C/SN 

700740 



GOTO 778 

700750 


777 

R2 » 1.0 

700760 


778 

RO = Rl*SN-C 

700770 



R1DOT=0.0 

700780 



GOTO 7775 

700790 

c 


GEOMETRY FOR CONE 

700800 


773 

CS = COSIG1) 

700810 



SN=SIN!G1) 

700820 



S = PHI 

700830 



Sl=1.0/S 

700840 



R2=CS*SN*PHI 

700850 



RO=PH I *CS 

700860 



R1D0T=0.0 

700870 



GOTO 7775 

700880 

c 


GEOMETRY FOR CYLINDER 

700890 


774 

RO = G1 

700900 



R 1 DOT=0. 0 

700910 



SN = 1.0 

700920 



CS = 1.0 

700930 



GOTO 7775 

700940 

c 

MOO I F I ED ELLIPSE 

700950 


775 

XNEXP = G1 

700960 



A =G2 

700970 



XN 1 = 1.0 ♦ XNEXP 

700980 



XN2 = 1.0/XN1 

700990 



XN3 = XN1 «• 1.0 

701000 



XN4 = XN3 + 1.0 

701010 



XN5 = XN4/XN1 

701020 



SN = SINIPHI ) 

701030 



CS = COSIPHI ) 

701040 



R2 = A*I2.0/(1.0*SN**XN1> )**XN2 

701050 



R1 = IA/2.0)*(R2/A1**XN3 

701060 



R0=R2*SN 

701070 



R1D0T = -XN3*A*ISN**XNEXP*CS/4.0)*12.0/I1.0*SN**XN1) )**XN5 

701080 



GOTO 7775 

701090 

c 


GENERAL GEOMETRY 

701100 


776 

SN = SINIPHI) 

701110 



CS = COSIPHI ) 

701120 



T AN= SN/CS 

701130 



SEC= 1.0/CS 

701140 



IF ITIME.EQ.TIC) CALL GEOMET 

701150 



ARG = PHI 

701160 



00 204 J= 1,100 

701170 



PHO = PSIIJ) 

701180 



IF (ANG.EQ.A) IF IARG-PHO) 221,223,204 

701190 



IF I PHO- ARG ) 221,223,204 

701200 


221 

IF IJ-1) 8502,8502,224 

701210 


204 

CONTINUE 

701220 
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GO TO 8503 

701230 

223 

RO = RAO ( J ) 

7012*0 


R1 = CUR1 ( J ) 

701250 


R2 = CUR2(J) 

701260 


R1D0T = OR 10P ( J ) 

701270 


GO TO 7775 

701280 

8502 

NERROR = *1 

701290 


GO TO 8888 

701300 

8503 

NERROR = *2 

701310 

8888 

NIX = 1 

701320 


GO TO 6889 

701330 

22* 

SUB1 = ARG-PSI l J-l ) 

7013*0 


SO 82 = PSI(J)-PSKJ-l) 

701350 


RO = RADU-l >+(RAD< J)-RAO( J-l I)*SUB1/SUB2 

701360 


R 1 = CUR1( J-1J-MCURH J)-CUR1( J-l> >*SUB1/SUB2 

701370 


R2 = CUR2( J-1)+(CUR2(J>-CUR2( J-l) >*SUB1/SUB2 

701380 


R1DOT = DR10P(J-1)>(DR1DP(J)-OR1DP(J-1) ) *SUB1/SUB2 

701390 


GOTO 7775 

701*00 


ISOTENSOID GEOMETRY 

701*10 

7077 

CONTINUE 

70 1*20 


SN = SINIPHI) 

701*30 


CS = COS { PHI ) 

701**0 


A = G1 

701*50 


R2 = A/SQRT ( SN) 

701*60 


R1 = 0.5 * R2 

701*70 


RO = R2 * SN 

701*80 


R1 DOT = - ( ( A**2)*0.5)*IR1*CS)/R0**2 

701*90 

7775 

TAN*SN/CS 

701500 


IF(TIME.EQ.TIC) RTICK=R0 

701510 


IF (NCYC.GT.l) GO TO *91 

701520 


IF (TIME. NE. TIC) GO TO *91 

701530 


I F ( NH. EQ .0 . ANO.NEO.EQ .0 1 GO TO *80 

7015*0 


AMAT(ITIC.l) * SAVY ( 22 ) 

701550 


AMAT ( I T IC • 2 ) = SAVY ( 23 ) 

701560 


AMAT(ITICt3J =• SAVY ( 5 ) 

701570 


AMATIITIC,*) = SAVY( 1 J*CS-$AVY ( 3 >*SN 

701580 

*80 

RADUS(ITIC) = RO 

701590 


IF (NSC.NE.l) GO TO *91 

701600 


SAOUS(JTIC) = RO 

701610 


IF(NH.EQ.O.ANO.NEO.EQ.O) GO TO *91 

701620 


AMAT ( JT I C« 5 ) = SAVY (22 I 

701630 


AMAT ( JT IC> 6 ) = SAVY ( 23 ) 

7016*0 


AMAT ( JT IC» 7 ) = SAVYt 5 ) 

701650 


AMAT ( JT IC • 8 ) = SAVY ( l )*CS-SAVY( 3 )*SN 

701660 

*91 

CONTINUE 

701670 


ROSQ = R0**2 

701680 


XNSQ=XN**2 

701690 


CN=CS*SN 

701700 


X1CS=1.0/C$ 

701710 


TN=SN/CS 

701720 


XIRO=1.0/R0 

701730 


X1R0SQ=1.0/R0**2 

7017*0 


X1CSR0=1 .0/ ( CS*RO ) 

701750 


CNIR0=CN/R0 

701760 


SN1R0=SN/R0 

701770 


CS1R0=CS/R0 

701780 


SNSQ=SN**2 

701790 


CSSQ=CS**2 

701800 


IF (KGEOM .EQ.*.OR.KGEOM.EQ.3 ) GOTO 79 

701810 


RISQ = Rl**2 

701820 


R2SQ = R2**2 

701830 


X 1 SN=1 ,0/SN 

7018*0 
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XISNRO=1.0/(SN*RO) 701650 

XI Rl=l .0/R1 701860 

X1R2=1.0/R2 701870 

CS1R1=CS/R1 701880 

CS1R2=CS/R2 701890 

SN1R1=SN/R1 701900 

X1R1$Q= 1 .0/R 1**2 701910 

79 XNTTH=0.0 701920 

XNTPH=0.0 701930 

XMTTH=0.0 701940 

XHTPH * 0. 701950 

C 701960 

C COMPUT AT ION OF K AND 0 FOR MATERIAL PROPETY INPUT 701970 

C 701980 

HO = 0.0 701990 

T = 0.0 702000 

HI =« 0.0 702010 

T$ = 0.0 702020 

TR = 0.0 702030 

TR « 0.0 702030 

RHOR = 0.0 702040 

RHOS =0.0 702050 

RHOI » 0.0 702060 

RHOC = 0.0 702070 

CTH = 0.0 702080 

CPH =0.0 702090 

YBARI = 0.0 702100 

YBARC = 0.0 702110 

VBARO = 0.0 702120 

GO TO (711,600, 711, 32.33, 34, 35, 36.37,28, 29,30). ISTTAB 702130 

C THICK 702140 

600 GO TO (703, 702, 701, 701), THICK 702150 

701 H0= ST ( 4 , LL ) 702160 

702 T = ST ( 3 , LL ) 702170 

RHOC = ST(NCONT-l.LL) 702180 

703 HI= ST ( 2 , LL ) 702190 

RHOI = ST(NCONT.LL) 702200 

GO TO 40 702210 

C ST 11, ST 12, ST 13 702220 

30 HQ= ST ( 14, LL ) 702230 

29 T = ST ( 1 3, LL ) 702240 

RHOC = ST ( NC0NT-3.LL ) 702250 

28 HI= ST ( 1 2,LL ) 702260 

RHOI = ST( NCONT-2 ,LL ) 702270 

RHOS = ST ( NCONT-l.LL ) 702280 

RHOR = ST(NCONT.LL) 702290 

GJPH= ST ( 2 , LL) 702300 

GJTH= ST ( 3, LL ) ’ . 702310 

APH = ST ( 4, LL ) 702320 

ATH = ST ( 5«LL ) 702330 

CPH = ST ( 6 , LL ) 702340 

CTH = ST (7,LL) 702350 

XIPH = ST( 8, LL I 702360 

XITH= ST ( 9, LL ) 702370 

SPH = ST ( 10, LL ) 702380 

STH = ST ( 11, LL) 702390 

IF (KELVIN. EQ. 2. OR. KELVIN. EQ. 4 ) GO fO 40 702400 

1STA8 = ISTTAB-9 702410 

TS = ST I ISTAB+12.LL ) 702420 

TR = ST ( ISTAB+13,LL) 702430 

GO TO 40 702440 
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C RWAF1 ,RWAF2,RWAF3 

34 HO =• ST(10,LL> 

33 T = ST ( 9 » LL ) 

RHOC = ST(NCONT-2,LL) 

32 HI = ST ( 8 » LL ) 

RHOI = ST ( NCONT- 1 »LL I 
RHOS = ST ( NCONT, LL) 

APH = ST ( 2 , LL ) 

CPH = ST ( 3, LL ) 

XI PH= ST(4,LL) 

SPH * ST ( 5 , LL ) 

BETTA=ST ( 6, LL ) 

ZETTA = ST ( 7 , LL ) 

ATH = APH 

CTH = CPH 

XITH** XI PH 

STH = SPH 

RHOR = RHOS* IWORD 

IF (KELVIN. E0.2. OR. KELVIN. EO. 4) GO TO 40 
ISTAB = ISTTAB-3 
TS = ST ( ISTAB+8, LL I 
TR = TS 
GO TO 40 

C I SGI , ISG2 , ISG3 

37 HO =* ST(9,LL) 

36 T =* ST ( 8 »LL ) 

RHOC ** ST ( NC0NT-2,LL ) 

35 HI =* ST ( 7, LL I 
RHOI => ST(NCONT-I.LL) 

RHOS = ST ( NCONT , LL I 
APH = ST ( 2,LL ) 

CPH = ST ( 3, LL) 

XIPH *» ST14.LL) 

SPH = ST ( 5, LL ) 

BETTA = ST ( 6,LL ) 

ATH = APH 
CTH = CPH 
XITH = XIPH 
STH » SPH 
RHOR =• RHOSMWORD 

IF (KELVIN. EQ. 2. OR. KELVIN. EQ. 4) GO TO 40 
ISTAB * ISTTAB-6 
TS = ST( ISTAB+7.LLI 
TR = TS 
GO TO 40 
ST 10.RWAF 

RANKIN=THSTND MEANS INTERPOLATE, COMPUTE NTEMP,MTEMP 
RANKIN=NOTHRM MEANS 00 NOT INTERPOL ATE, 00 NOT COMPUTE NTEMP.NTEMP 
RANKIN»THCNST MEANS 00 NOT AVERAGE, BUT INTERPOLATE, COMPUTE 

NTEMP, MTEMP 

RANK I N=THINHO MEANS INTERPOLATE, BUT 00 NOT COMPUTE NTEMP, MTEMP 

711 CONTINUE 

XK1I = ST ( 2,LL ) 

XK12=ST ( 3 , LL ) 

XK22 « ST ( 4, LL ) 

XK33 = ST ( 5, LL ) 

X011 = ST ( 6, LL ) 

X012 = ST ( 7, LL ) 

X022 = ST( 8, LL ) 

X033 = ST ( 9, LL ) 

XC11 - ST(10,LL) 


702450 

702460 

702470 

702480 

702490 

702500 

702510 

702520 

702530 

702540 

702550 

702560 

702570 

702580 

702590 

702600 

702610 

702620 

702630 

702640 

702650 

702660 

702670 

702680 

702690 

702700 

702710 

702720 

702730 

702740 

702750 

702760 /- 

702770 

702780 

702790 

702800 

702810 

702820 

702830 

702840 

702850 

702860 

702870 

702880 

702890 

702900 

702910 

702920 

702930 

702940 

702950 

702960 

702970 

702980 

702990 

703000 

703010 

703020 

703030 

703040 

703050 

703060 
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ooo ooo ooo 


XC22 * ST ( 1 1 * LL ) 

XC 15 = ST(12,L'L> 

XC 16 * ST ( 13»LL ) 

XMERD = ST ( NCONT-2, LL ) 

XPRES * ST( NC0NT-1,LL 1 
XMONT * ST (NCONT »LL I 
XK21 = XK12 
XD21 = X012 
GO TO 103 

40 CONTINUE 

IF (IH0RD.EQ.1) GO TO 140 
RHOR = 0.0 
RHOS = 0.0 
RHOI » 0.0 
RHOC = *0.0 
XMERD = 0.0 
XPRES => 0.0 
XMONT * 0.0 
140 CONTINUE 

TEMP3= (1.0-XNUPT * XNUTP) 

GO TO (42*47, 49, 411, THICK 

41 GO TO (103, 42, 103, 42, 47, 49, 42, 47, 49, 42, 47, 49), ISTTAB 
SINGLE SHEET 

42 TEMPI * ETHET*HI 
TEMP2= TEMPI * HI**2 
XK11* TEMP1/TEMP3 

XD11= TEMP2/ ( 12.0* TEMP3 ) 

TEMPI * EPHI*HI 
TEMP2= TEMP1*HI**2 
XK22* TEMP1/TEMP3 
XD22= TEHP2/U2.0* TEMP3 > 

XK33 = XGPT *HI 

XD33= XK33*HI**2/12.0 

YBARI a 0.0 

YBARC = 0.0 

YBARO = 0.0 

GO TO 55 

EQUAL SHEETS 

47 CONTINUE 

XK 11 = 2.0*ETHET*HI/TEMP3 

XK22 = 2.0*EPHI*HI/TEMP3 

XK33 = 2.0*XGPT 

ZBR = HI+-T/2.0 

ZBH = ( ZBR-HI/2 .0 >** 2 

XD33 = XGPT*HI*( ( HI 4*2 >/6 .0*2 .0*ZBH > 

XD11 = HI*(XKll*HI/12.0+2.0*ETHET*ZBH/TEMP3) 

XD22 = HI*(XK22*HI/12.0*2.0*EPHI*ZBH/TEMP3) 

YBARI a ZBR-HI/2. 0 
YBARC = Z8R-HI-T/2.0 
YBARO a H 1/2.0— ZBR 
GO TO 55 

UNEQUAL FACE SHEETS 
49 CONTINUE 

ZBR = (HI*HlEH0*H0+2.0*( HO* (HI+T )> ) /(2 . 0 * (HIeHO > ) 


703070 

703080 

703090 

703100 

703110 

703120 

703130 

703140 

703150 

703160 

703170 

703180 

703190 

703200 

703210 

703220 

703230 

703240 

703250 

703260 

703270 

703280 

703290 

703300 

703310 

703320 

703330 

703340 

703350 

703360 

703370 

703380 

703390 

703400 

703410 

703420 

703430 

703440 

703450 

703460 

703470 

703480 

703490 

703500 

703510 

703520 

703530 

703540 

703550 

703560 

703570 

703580 

703590 

703600 

703610 

703620 

703630 

703640 

703650 

703660 

703670 
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O O O ODD 


ZBHIN = (ZBR-HI/2.0 1**2 
ZBHOUT = (Z8R-H0/2. 01**2 
XK11 = ETHET*(HI+HOI/TEMP3 
XK22 = EPHI*(HI*H01/TEMP3 
XK33 = XGPT*(HI+HO» 

HI 03 = HI**3*H0**3 

XD33 = HI03*XGPT/12.0+XGPT*(HI*ZBHIN*HO*ZBHOUTi 
Dll * ETHET*HI03/12.0 

XD11 = (01l*ETHET*( HI*ZBHIN*HO*ZBHOUT 1) /TEMP 3 
022 = 6PHI*HI03/ 12. 0 

XD22 = (D22+EPHI*(Hl*Z8H IN +H0* ZBHOUT U/TEMP3 
Y8ARI = ZBR-HI/2.0 
YBARC = ZBR-HI-T/2.0 
YBARO = HI/2.0-ZBR 

DETERMINE complete constants dependent on reinforcement clue 

55 CONTINUE 

ROI = RO-YBARI*SN 
ROU = RO-YBARO*SN 
ROC * RO-YBARC*SN 
IF (THICK. EQ. 2) HO = HI 

IF ( ISTTAB.EQ.5.0R. ISTTAB .EQ. 8. OR . ISTTAB .EQ. ID HO = HI 

D3 = RHQI*ROI*HI 

D4 = RHOC*ROC*T 

D5 = RHO I *ROU*HO 

DD = D3+D4+D5 

XMERD » DD*OHEGA*CS 

XPRES = -0D*0MEGA*SN 

XMONT « - ( D3*YBAR I-*-D4*YBARC+D5*YBAR0l*0MEGA*CS 

IF ( ISTTAB .EQ.2 )G0 TO 103 

TBARR * ATH/STH 

TBARS = APH/SPH 

ROR = RO-CTH*SN 

ROS = RO-CPH*SN 

E AST H=ER* ATH/STH 

EASPH=ES*APH/SPH 

E I SPH= ES* X IPH/SPH 

E I STH= ER* X ITH/STH 

D1 = RHOR*ROR*T BARR 

D2 = RHOS*ROS*TBARS 

OD = Dl+D2+D3+D4*05 

GO TO (58,60, 1001.KLUE2 

ST CLUE (11,12,131 

58 CONTINUE 

XK 12= XK 1 1*XNUT P 
XK11= XK 11+ EASTH 
XK22= XK22+ EASPH 
XCll= EASTH*CTH 
XC22= EASPH*CPH 
X022= - X022 - EISPH 

XD33= X033 + GJPH/(4.0*SPH1+ GJTH/( 4.0*STH 1 

XD12= -XD 1 1*XNUTP 

XD l 1= -XD11- EISTH 

XK21 = XK12 

X021 = XD12 

XMERD = 00*0MEGA*CS 

XPRES « -DD*OMEGA*SN 

XMONT = -(D1*CTH*D2*CPH+03*YBARI« : D4*YBARC*D5*YBARO)*OMEGA*CS 
GO TO 103 


T03680 

703690 

703700 

703710 

703720 

703730 

703740 

703750 

703760 

703770 

703780 

703790 

703800 

703810 

703820 

703830 

703840 

703850 

703860 

703870 

703880 

703890 

703900 

703910 

703920 

703930 

703940 

703950 

703960 

703970 

703980 

703990 

704000 

704010 

704020 

704030 

704040 

704050 

704060 

704070 

704080 

704090 

704100 

704110 

704120 

704130 

704140 

704150 

704160 

704170 

704180 

704190 

704200 

704210 

704220 

704230 

704240 

704250 

704260 

704270 

704280 

704290 
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no o o o on 


RWA CLUE (1*2.3) 

60 CONTINUE 

SINB =SIN( BETTA) 

COSB =C0S (BETTA ) 

SN2T04 = 2*(SINB**4. I 
D= STH*( COSB+SINB ) 

EO » ER*ATH/D 
S I NB2 = SINB**2. 

HL * 2.0*( ABS(ZETTA)-ABS(CTH) ) 

I2=(ATH**3. )/( 3* HL**2) 

95 XC22 = 2.0*CTH*COSB**3*EO 
XC 15 * 2.0*CTH*C0SB*SINB2*ED 
XC16 = XC15 

GR 1= ER* 12/(2. 0*(1.0 ♦ XNUTP)*D> 

XC11 = CTH*SN2T04/C0SB*£D 
EDI - ER*X ITH/O 
SN4T02 * 4 .*SINB2 

XD22 = -XD22-2.0*C0SB**3*E0I-SN4T02*C0SB*GRI 
TB= 2.0* BETTA 
XD33 = XD33-M (4.0*C0S( TB )* 
i*2*GRI )/ COSB) ♦ (2.0*C05B*SINB2*EDI ) 

X012 = -XD11*XNUTP-(2.0*C0SB 
1*S INB2*E0I )-(SN4T02*C0SB*GR I ) 

XK12= XK11*XNUTP «• (2.0*C0SB*SINB2*ED) 
XK22=XK22+ ( 2*COSB**3*EO) 

XK33=XK33+( 2*COSB*S INB2*ED ) 
XKllaXKll-MSN2T04*ED/C0SB) 

XD11 * -X011-SN2T04*E0I/C0$B-( 

1 SN4T02*C0SB*GR I ) 

XK21 = XK 12 
XD21 = XD12 
GO TO 108 

ISG CLUE (1,2,3) 

100 CONTINUE 

SNB =SIN( BETTA) 

CSB =COS(BETTA) 

TBETTA- 2.0*BETTA 
CS2B= COS(TBETTA) 

ONEC2B=(1.0+ CS2B ) / 2 . 

SCB2 =(SNB-CS2B*SNB ♦' 2. ) / ( 2 . 0*CSB ) 

SN2B = SIN( TBETTA ) /2. 

XK12=XKil*XNUTP + ( EASTH*SNB*0NEC2B/CSB ) 

XK 1 1=XK 1 1* EASTH*SCB2 
XK22=XK22+ EASTH*(CSB/SNB*ONEC2B) 

XK33=XK33+ EASTH* SN2B 
XCll = • ( EASTH*CTH* SCB2 » 

XC15=EASTH*CTH*( SNB* ONEC2B/CSB ) 

XC 16=EASTH*CTH*SN28 

XC22= E ASTH*CTH* (CSB/SNB * 0NEC2B) 

XD12=-X011*XNUTP- E ISTH*( SNB*ONEC2B/CSB ) 

XD11=-XDU- EISTH*SCB2 

XD22 = -X022-EISTH*(CSB/SNB*0NEC2B) 

XD33= X033* EISTH*SN2B 
XK21 a XK 12 
X021 = X012 


108 XMERD a ( 00-02 )*OHEGA*CS 
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c 

c 


c 


c 

c 


XPRES - -(DD-D2I*0HEGA*SN 

XMONT « -(Ol*CTH*03*YBARI*D4*YBARC*D5*YBAR0)*0MEGA*CS 
103 CONTINUE 

IE ( KGEOM.NE .4 ) GO TO 105 
XMERO » 0.0 
XMONT >0.0 
105 CONTINUE 

GO TO (716,714,715,714) .KELVIN 

716 TII > ST ( NROM+1 . LL ) 

TIK = ST ( NROW+2, LL ) 

TOK > ST ( NR0W*3 , LL ) 

TOO > ST ( NR0W+4, LL ) 

GOTO 717 

715 TII * ST < NROM+1 . LL ) 

TIK = TII 
TOK = TII 
TOO > TII 

717 TEMPI = ALPHTH*XNUTP*ALPHPH 
TEMP2 = ALPHPH*XNUPT*ALPHTH 
TEMP3 > 1-XNUPT*XNUTP 
TEMP4 > HI/4.0 

ETHK1 > ETHET*TEMP1/TEMP3 
TEMPS » HI**2/24.0 
TEMP61= TII* TIK-2* TEFREE 
TEMP62* TOO* TOK-2* TEFREE 
TEMP71> 2.0* TII *TIK-3*TEFREE 
TEMP72* 2.0* TOO *T0K-3*TEFREE 
EPHK1 > EPHI*TEMP2/TEMP3 
GO TO (811.812. 813. 814), THICK 

814 GO TO (815, 811, 815, 811,812, 813. 811, 812, 813, 811, 812, 813), ISTTAB 

811 XNTTH= ETHK1 * TEMP4 * (TEMP61* TEMP62) 

XNTPH> EPHK1 * TEMP4 * (TEMP61 ♦ TEMP62) 

XMTTH= ETHK1 * TEMP5 * ( TEMP71- TEMP72 ) 

XMTPH= EPHK1 * TEMP5 * (TEMP71 - TEMP72) 

GO TO 816 

812 T I = T/2.0 
TEMP8= HI/2.0 

XNTTH = ETHK1*TEMP8*( TEMP6 1+TEMP62 ) 

XNTPH = EPHK 1*TEMP8*( TEMP61+TEMP62) 

XMTTH « ETHK1*TEMP8*(HI* ( TEMP71-TEMP72 )/3.0+TI*(TEMP61-TEMP62)) 
XMTPH = EPHK1*TEMP8*( HI* ( TEMP7 1-TEMP72 ) /3.0+T I *(TEMP61-TEMP62)) 

GO TO 816 

813 T I > (H0**2-HI**2*2.0*H0*T)/(2.0*(HI*H0) ) 

TO » ( HI **2-H0**2+2 .0*HI*T)/(2 .0*( HI*HO ) ) 

XNTTH * ETHK1/2.0*(HI*TEMP61*H0*TEMP62) 

XNTPH = EPHK1/2.0*(HI*TEMP61*H0*TEMP62 ) 

XMTTH = ETHK 1/2 .0*( HI**2*TEMP71/3.0-H0**2*TEMP72/3.0*TI*HI *TEMP61- 
1 TO*HO*TEMP62 ) 

XMTPH > EPHK 1/2. 0*( HI**2*TEMP71/3. 0-HO**2*TEMP72/3.0+TI*HI*TEMP61- 
1 T0*H0*TEMP62 ) 

816 CONTINUE 

IF (ISTTAB. EQ. 2) GO TO 714 
GO TO (817,818,819),KLUE2 

817 XNTPH = XNTPH*ES*APH/SPH*ALPHS*TS 
XNTTH > XNTTH*ER*ATH/STH*ALPHR*TR 
XMTPH > XMTPH+CPH*ES*APH/SPH*ALPHS*TS 
XMTTH • XMTTH*CTH*ER*ATH/STH*ALPHR*TR 


704910 

704920 

704930 

704940 

704950 

704960 

704970 

704980 

704990 

705000 

705010 

705020 

705030 

705040 

705050 

705060 

705070 

705080 

705090 

705100 

705110 

705120 

705130 

705140 

705150 

705160 

705170 

705180 

705190 

705200 

705210 

705220 

705230 

705240 

705250 

705260 

705270 

705280 

705290 

705300 

705310 

705320 

705330 

705340 

705350 

705360 

705370 

705380 

705390 

705400 

705410 

705420 

705430 

705440 

705450 

705460 

705470 

705480 

705490 

705500 

705510 

705520 
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GO TO 714 

818 TEH = ES*APH/SPH*ALPHS*TS 
XNTPH * XNTPH+TEN 

XNTTH = XNTTH*TEN 
XNTPH = XNTPH+CPH*TEH 
XMTTH = XMTTH+CPH*TEM 
GO TO 714 

819 TEN = ES*APH/SPH*ALPHS*TS 
XNTPH * XNTPH*TEN*CS8/SNB 
XNTTH = XNTTH+TEN*! 1.0+SNBI/CSB 

!r ' XNTPH = XNTPH*CPH*TEN*CSB/SNB 

■ XNTTH = XNTTH+CPH*TEN*l 1.0*SNB)/CSB 
GO TO 714 

815 TENPIO = ( (-XK11*X011 J**.5)/(48.0**.5> 
TEN11 =( (-XK22*XD22>**.5)/(48.0**.5> 
XNTTH = XK 1 l/4iO*T£NPl*l TEMP61 + TENP62)' 
XNTPH = XK22/4.'0*TENP2*( TENP61+TEHP62 ) 
XNTTH = TENP10*T£MP1*( T ENP7 1-TENP72 ) 
XNTPH = TEN11*TEMP2*(TEHP71-TEHP72> 



714 CONTINUE 

IF (NH.NE.O.OR. (NCYC.NE.0.AND.KKNT.NE.4I ) GO TO 8889 
IF (NEO.NE.O) GO TO 8889 
DO 1234 K=1,K8C 
DO 1235 J=lt3 
SIGMA(J.K) = 0.0 
SEPS(JtK) = 0.0 
SALPH(J.K) = 0.0 
1235 SBAPH(JtK) = 0.0 
EFF(K) = SIGOX 
1234 NPLA(K) = 0 

DO 1238 J=1 » 3 
STSRNIJ) =0.0 
NPLAST I J ) = 0 
STSIG(J) = 0.0 
STREPS ( J ) = 0.0 
STALPHI J I = 0.0 
STBAPHIJ) = 0.0 
NPLEVS ( J I = 0 
1238 EFFST(J) = SIGOXS 

IF (KLUE2.EQ.1) EFFSTI2) = SIGOXR 
DO 1237 J= 1 « 6 
1237 STRI J I = 0.0 
NPLEV = 0 

IF (KELVIN. EQ.l. OR. KELVIN. EQ. 3) GO TO 110 
DO 111 K=1,K8C 
DO 111 J = 1 * 3 
111 STEPS l J» K ) = 0.0 
GO TO 112 

110 IF (THICK. NE.1J GO TO 113 
NLH = NLRS/2+1 
DO 115 LR= 1* NLH 

T = T0K+2.0*ZETA1(LRI*(TI I-TOK ) 

STEPS ( 1 1 LR ) = ALPHPH*T 
STEPS ( 2 1 LR ) = ALPHTH*T 

115 STEPS! 3. LR ) ■ = 0.0 
NLH = NLH+1 

DO 116 LR=NLH,NLPO 
T = TOK+2.0*ZETA1(LR)*(TOK-TOO) 

STEPSdtLR) = ALPHPH*T 
STEPS ( 2 1 LR ) = ALPHTH*T 

116 STEPS( 3,LR ) = 0.0 





705530 
705540 
705550 
705560 
f 705570 
705580 
705590 
705600 
705610 
705620 
705630 
705640 
705650 
705660 
705670 
705680 
705690 
705700 
705710 
705720 
705730 
705740 
705750 
705760 
705770 
705780 
705790 
705800 
705810 
705820 
705830 
705840 
705850 
705860 
705870 
705880 
705890 
705900 
705910 
705920 
705930 
705940 
705950 
705960 
705970 
705980 
705990 
706000 
706010 
706020 
706030 
706040 
706050 
706060 
706070 
706080 
706090 
706100 
706110 
706120 
706130 
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GO TO 112 706140 

113 00 200 K-1,2 706150 

00 200 LR-l.NLPO 706160 

LRT » LR*(K-1)*NLP0 706170 

GO TO <300. 400), K 706180 

- 300 T » TIK*ZETA2<LR)*<TII-TIK) 706190 

GO TO 500 706200 

400 T ■ TOK+ZETA2(LR)*(TOO-TOK> 706210 

500 STEPS! 1. LRT) - ALPHPHOT 706220 

STEPS(2*LRT) - ALPHTH*T 706230 

200 STEPSI3.LRT) * 0.0 706240 

112 CONTINUE 706250 

DO 1236 K-1,53 706260 

1236 SAVY(K) » 0.0 706270 

WRITEtIO) SAVY. NPLEV.NPL A. SIGMA. SALPH. SBAPH. STEPS. STR.EFF.STSRN. 706280 
1 NPLAST.STS1G.STREPS.STALPH.STBAPH.NPLEVS.EFFST.SEPS 706290 

8889 RETURN 706300 

ENO 706310 


41 



ooonooo o-ooooo noon o o onooooooo 


FOR, IS GEOMET »GEOMET 

SUBROUTINE GEOMET 

THIS SUBROUTINE CALCULATES THE GEOMETRY FOR A SHELL SEGMENT. 

THE INPUT VARIABLES ARE ... 

RIII) OISTANCE FROM AXIS OF REV. TO POINTS 

ON SHELL MERIDIAN. 

ZICI) DISTANCE ALONG AXIS OF REV. TO THE 

INTERSECTION OF THE CORRESPONDING R I t I ) AND 
THE AXIS OF REV. 

NRZIN NUMBER OF (RI.ZI) PAIRS READ AS INPUT. 

COMMON /SPLINS/ ANG,PS I ( 100 > , RAO( 100 ) ,CUR1 ( 100) ,CUR2 ( 100 ) , 

1 0R1DP ( 100 ) ,Z I ( 14) ,RI ( 14 ) , NRZ IN 

DIMENSION Cl (4, 13),0RDZ< 14 ) , S0UTM4) , S 1 101 ) ,RADO 1 100 ) 

FUN(ARG) = SORT! 1.0 ♦ ARG**2) 

RADS = 3.1415926/180.0 
DATA B/'B •/ 

AMULT = 1.0 

IF (ANG.EQ.B) AMULT » -1.0 

PASS SPLINE CURVE THROUGH INPUT POINTS ON SHELL MERIDIAN, AND 
COMPUTE DR/DZ AT THESE POINTS. 

CALL PLICO (ZI,RI, NRZIN, Cl) 

NDELZ * NRZIN - 1 
DO 60 1=1, NRZIN 

CALL PLINE (Z1,RI, NRZIN, Cl, ZI ( I ) ,FAKE1 ,ORDZI I > , FAKE2 ) 

60 CONTINUE 

COMPUTE MERIOIQNAL ARC LENGTH TO INTERPOLATED POINTS BY 
NUMERICAL INTEGRATION (SIMPSONS RULE). SINCE SIMPSONS RULE 
REQUIRES AN EVEN NUMBER OF PARTITIONS, INTERPOLATE A POINT 
MIDWAY BETWEEN EACH PAIR OF POINTS USING SUBROUTINE SPLINE. 

SOUT(l) =0. 

00 70 1=1, NDELZ 
DZ2=(ZI( I*1I-ZI( I ) 1/2.0 
DZ6=DZ2/3.0 

CALL PLINE IZI.RI, NRZIN, Cl, Z I ( I ) ♦DZ2,FAKE1 , DRDZM.FAKE2 ) 

SOUTd + l) = SOUT(I) ♦ DZ 6* ( FUN ( DRDZ ( I ) ) ♦ 4. 0*FUN(DRDZM) ♦ 

1 FUN ( DRDZ ( I 1 ) ) ) 

70 CONTINUE 

USE SPLICO TO REPRESENT RIII) AS A FUNCTION OF SOUT(I). THEN USE 
SPLINE TO INTERPOLATE RADD ANO CORRESPONDING DERIVATIVES. FROM 
THESE, COMPUTE THE TWO PRINCIPAL RADII OF CURVATURE, 

CURl = 1/R1 
CUR2 = 1/R2 

OLOH1 = SOUT (NRZIN1/99.0 
CALL PLICO (SOUT, RI, NRZIN, Cl) 

DO 110 1=1,100 
S I 1 ) = FLOAT (I-1)*0L0H1 

CALL PLINE (SOUT, RI, NRZIN, Cl, S(I) ,RAD( I ) ,RADD( I ) ,RADD2 ) 

IF (ABS(RADD(I) l.GT.l.O) RADD(1)=1.0 
FACTOR = SQRT(l.O-RAOD( 1)4*2) 

CURKI) = -RADD2/F ACTOR 
CUR2 ( I ) * FACTOR/RAOU) 


2300010 

2300020 

2300030 

2300040 

2300050 

2300060 

2300070 

2300080 

2300090 

2300100 

2300110 

2300120 

2300130 

2300140 

2300150 

2300160 

2300170 

2300180 

2300190 

2300200 

2300210 

2300220 

2300230 

2300240 

2300250 

2300260 

2300270 

2300280 

2300290 

2300300 

2300310 

2300320 

2300330 

2300340 

2300350 

2300360 

2300370 

2300380 

2300390 

2300400 

2300410 

2300420 

2300430 

2300440 

2300450 

2300460 

2300470 

2300480 

2300490 

2300500 

2300510 

2300520 

2300530 

2300540 

2300550 

2300560 

2300570 

2300580 

2300590 


4 ? 



110 

CONTINUE 

2300600 


00 180 J*i,100 

2300610 


COSPSI = AHULT *RAOO( J ) 

2300620 


PSIIJI = ARCOSI COSPSI ) 

2300630 


SINPSI = -ANULT *R ADI J )*CUR2( J ) 

2300640 


IF (ANG.EQ.B) 60 TO 179 

2300650 


PS1U) = 2.0*3. 1415926-PSK J) 

2300660 

179 

CONTINUE 

2300670 


CUR1(J) * -AHULT/CURK J) 

23006B0 


CUR2 ( J ) = -AMULT/CU«2( J) 

2300690 


IF IJ.EQ.l) GO TO 180 

2300700 


I * 1 

2300710 


IF (J.EQ.2) GO TO 181 

2300720 


I = 2 

2300730 

181 

IF (ANG.EQ.B) GO TO 190 

2300740 


DR1DPIJ-1) = (CURl(J)-CURlf J-in/(PSI( J>-PSItJ-I>> 

2300750 


GO TO 180 

2300760 

190 

DRlOP(J-l) * (CURl(J-I)-CURl(J))/(PSI(J-n-PSI(J)) 

2300770 

180 

CONTINUE 

2300780 


ORIOP(IOO) * DRIDPt 99 ) 

2300790 


DO 42 J=l,100 

2300800 


DRIOP(J) = 0R10P( J ) *0. 1 

2300810 

42 

CONTINUE 

2300820 


RETURN 

2300830 


ENO 

2300840 
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FOR, I S PLICO, PLICO 

SUBROUTINE PLICO (X,Y,M,C> 

C SUBROUTINE TO DETERMINE C( 1 ,K ) ,C ( 2t K) ,C ( 3,K ) ANO C(4,K>. 
01 MENS ION X(14) ,Y(14),A( 14, 3),B( 14),Z( 141 
DIMENSION 0(131, P(13).E(13), CIA, 13» 

MM = M— 1 

DO 10 K* 1, MM 

D( K) ■ X (K+l I - X(K ) 

P ( K ) » 0(K)/6.0 
10 E(K) = (Y(K*1)-Y(K) )/D(K) 

DO 20 K=2,MM 
20 B( K ) = E(K ) - E(K-l) 

All, 2) = -1.0-0(11/0(2) 

All, 3) = 0(11/0(2) 

A( 2, 3 ) = P( 2 ) — P ( 1)*A(1,3) 

A( 2,2) = 2.0*(P(1 )+P( 2) ) — P(l)*Afl,2) 

A ( 2,3) = A(2,3)/A(2,2) 

B( 2) * B(2)/A(2,2) 

00 30 K=3,MM 

A t K, 2 ) = 2.0*(P(K-1)+P(K))-P(K-1)*A(K-1,3) 

B(K) = B(K)-P(K-l)*B(K— 1) 

A(K,3) = P(K)/A(K,2) 

30 B(K) = B(K)/A(K,2) 

0 * 0(M-2 )/D(M-l 1 
A ( M, 1 ) = 1 . O+Q+A (M— 2, 3 I 
AIM, 2) = -Q— A( M, 1 ) *A( M— 1 , 3 ) 

B ( M) = B ( M-2 )-A(M,l)*B( M-l ) 

Z(M) - B(M)/A(Mj2) 

MN » M-2 
00 40 1=1, MN 
K — H— I 

40 ZIK) * B(K)-A(K,3)*Z(K+1 ) 

Z(l) = -A(l»2)*Z(2)-A(l»3)*ZI3) 

DO 50 K= 1, MM 
Q = 1 • 0/ ( 6 .0*D( K ) ) 

C(1,K> = ZIK) *Q 

C(2,K) = Z(K+1)*Q 

C ( 3,K ) = YIK)/DIK)-ZIK)*PIK) 

50 C (4, K ) = Y(K*1)/0(K|-Z(K*1)*P(K) 

RETURN 

END 


2500010 

2500020 

2500030 

2500040 

2500050 

2500060 

2500070 

2500080 

2500090 

2500100 

2500110 

2500120 

2500130 

2500140 

2500150 

2500160 

2500170 

2500180 

2500190 

2500200 

2500210 

250^220 

2500230 

2500240 

2500250 

2500260 

2500270 

2500280 

2500290 

2500300 

2500310 

2500320 

2500330 

2500340 

2500350 

2500360 

2500370 

2500380 

2500390 

2500400 
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o 0 0.00 


FOR, IS PLINE.PLINE 

SUBROUTINE PLINE < X, Y,M,C, X INT , Y INT , DYDX.D2YDX2 ) 

SUBROUTINE FOR SPLINE FIT INTERPOLATION IN THE TABLE OF VALUES 
(Xl.Yl) TO (XM,YM>, WHERE M MAY BE AS LARGE AS 100» WHERE THE 
CONSTANTS C< 1,K > , C ( 2,K ) ,C ( 3,K ) ANO C(4,K) ARE ALREADY COMPUTEO 
AND STOREO. 

SUBROUTINE ALSO COMPUTES DY/DX AND D2Y/DX2 AT XINT. 

DIMENSION X(14),Y<14),C<4,13) 

'IF (XINT-X(D) 80.10,20 
10 YINT = Y 1 1 ) 

K=1 

GO TO 70 
20 K = 1 
• 30 IF ( XINT-X ( K+l ) > 60,40,50 
40 YINT = Y(K*1) 

GO TO 70 
50 K'= K ♦ 1 

IF (M-K) 80,80,30 

60 YINT = IX(X+1» - XINT)*(C(1,K)*(X(K+1)-XINT)**2+C13,K) ) 

YINT = YINT ♦ (XINT-X(K))*1C(2,K)*IXINT-X(K))**2+C(4,K)) 

70 DY0X=-3.0*(C(1,K)*(X(K+1 l-XINT >** 2-C ( 2, K )* I X INT-XI Kl )**2 ) 

1 -C(3,K)+Ct4,KJ 

02YDX2=6.0*IC(1,K)*<XIK*1)-XINT)+C(2,K)*( XINT-X (K) I) 

RETURN 

80 WRITE (6,90) 

90 FORMAT ( 31H OUT OF RANGE FOR INTERPOLATION) 

• RETURN 
END 


2400010 

2400020 

2400030 

2400040 

2400050 

2400060 

2400070 

2400080 

2400090 

2400100 

2400110 

2400120 

2400130 

2400140 

2400150 

2400160 

2400170 

2400180 

2400190 

2400200 

2400210 

2400220 

2400230 

2400240 

2400250 

2400260 

2400270 
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SUBROUTINE DIF1 AND DIEF2 


These subroutines are called in RIEMAN as necessary. DIF1 contains 
the differential equations for the THIC and ST clues, while DIFF2 contains 
the differential equations for the KWA and ISG clues. Geometry clues, 
trigonometric values, and predicted values of the differential equation 
variables are passed via label common area, EQUAZN, to subroutines DIF1 
or DIEF2. The coefficients for nonlinear and load terms, XI, X2, X3 and 
K, are identified depending upon the input clues and pass number. 

The specific derivative equations and auxiliary equations are contained 
in these subroutines. The values of each derivative equation, YDOT, and 

each auxiliary equation, YA , are returned to RIEMAN via label common 

EQUAZN. 

A special equation counter, I, is used in these subroutines, which counts 
in increments of eight. The first eight values of I, 1 through 57 (in 
increments of eight), correspond to the eight sets of initial conditions 
required to compute the segment stiffness matrices in subroutine SEGMAT. 
The subsequent value of I, 65 (again an increment of eight) corresponds 
to the computation of a set of eight equations for the loading condition. 
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FORTRAN CODE 

ENGINEERING SYMBOLS (REF. 

i) 

XN 

n 


YDOT (I) 

T 

66 >6 

dT 60 

ds 

YDOT (I + 1) 

% ,6 

dN . 
ds 



dJ. 

YDOT (1+2) 

J <p ,<{> 

6 

ds 



dM 

YDOT (I + 3) 

M 

6,6 

6 

ds 

YDOT (1 + 1+) 

U 5 6 

dU 

ds 

YDOT (1+5) 

V ’6 

dV 

ds 

YDOT (I + 6) 

% 

dW 

ds 

^_e 

ds 

YDOT (1+7) 

fi e,6 

YPRED (I) 

T 60 


YPRED (I + 1) 

% 


YPRED (1+2) 

J 6 


YPRED (1+3) 

M 6 


YPRED (I + k) 

u 


YPRED (1+5) 

V 


YPRED (1+6) 

w 


YPRED (I + 7 ) 

n 0 


YAMPT 

V 


YANTH 

N e 


YAMTH 

M e 
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FORTRAN CODE 

ENGINEERING SYMBOLS- (REF. l) 

R2SQ 

OJ 

ROSQ 

o 4 

ro 

X1R0 

L / r o 

S 

s 

XK12 


XK21 

K 21 

XD12 

D 12 

XD21 

D 21 

XC11 

C 11 

XC22 

C 22 

XNSQ 

2 

n 

Non-Linear Redefinitions (Ref. 2 ) 


YD0T (1+2) 
YPEED (1+2) 
YAJPH • 

SAVY ( ) 


T 


d*J 

. t 

ds 
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appropriate nonlinear or plastic 
load terms updated from previous 
load increment. 



DIF 1 


ENTRY 
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FOR, IS OIF1, DIF1 

C ROUTINE ** OIF1 ** ABACUS UPDATED 01/11/74 

SUBROUTINE 0IF1 

INTEGER SAVJTC, SAVS TP, Q, THICK 


C 

C 


INTEGER XNl.XN 
REAL K 

DOUBLE PRECISION YPREO 

COMMON STORY ( 16 ),XM AT (270,10} , STD ( 10) « SAOUS (301 .RADUS130) 

COMMON TADUS130) ,UAOUS ( 30 > , SAVTIC ( 900 > 

COMMON XN.TEFREE, TIC, PHI, STOP, RESTOP, RTICK, G1 , XNL 1 3) ,NH 
COMMON NST ( 30 ) ,NKL( 30 ) , NXHATl 20) , SAVJTC (30) ,SAVSTP(30> ,JRTIC(30) 
COMMON JRSTOP (30 ) *NR£G,NMPT ,NRC,NSC,NIX, IERROR, KGEOM , IGEOM, ISTT AB 
COMMON KELVIN, I BEGIN, NPROB, NSEG, NERROR, Q, THICK, NOJ S, NLINKS .NLCASE 
COMMON NTSKL.NZ, NBC T,L INPUT, NTRKL ,NPASS , XNl , KBC .NRINGS 
COMMON LODE, ICYCLE,LOISTL 

COMMON /EQUA2N/ YPRE0(72 ) ,YOOT< 72 ) , YASAVEI72 ) , 

1 YANTH,YAHTH,YAMPT,YAJPH, 

2 S , SN,CS, SNSQ, CSSQ «TAN, SEC,CN, X1CS* XI SN,TN, 

3 X1RO«X1ROSO,X1SNRO,X1CSRO,CN1RO,SN1RO,CS1RO, 

4 X1R1,X1R2,CS1R1,CS1R2,SN1R1,X1R1SQ,R2SQ,R0,BESQ, 

5 ROSQ,XNSQ, BETA, R1,R2,S1 ,R 100T , 

6 XNTTH,XNTPH,XMTTH,XMTPH,XFTHLD, XFPHL D, XFZELD, 

7 XMTHLO,XMPHLO, ETHET ,EPHI ,XGPT ,ALPHTH ,ALPHPH, 

8 XNUTP , XNUPT,XC11,XC22,XC15,XD33,X022,XD21,XD12, 

9 XK11,XK12,XK21,XK22,XK33,XD11, 

A XNPHI.H, I , BETTA , ZETTA, XC 16 

COMMON /WOOD/ SAVYl 53 ) .NPLEV.NLPO ,NPLA ( 21 ) , SIR ( 6 ) , SI GMA( 3 ,21 ) , 

C SEPS(3,21) ,SALPH(3,21 ) ,SBAPH( 3, 21 ) ,STE PS ( 3,21 ) , 

0 EFF(21),STSRN(3),NPLAST(3),STSIG(3),STREPS(3) , 

M STALPH(3),STBAPH(3) ,EFFST(3) ,NPLEVS(3) 

COMMON /PLS/ OMEGA, 1W0RD ,XMERO, XPRES.XMDNT 
COMMON /COISP/ P,PMAX,DELP,0ELP1,YEPS,ZEPS 
EQUIVALENCE ( XNL ( 1 I ,X 1 ) , ( XNL ( 2 ) , X2 > , I XNL ( 3 ) , X3 ) , ( K ,D ELP) 

IF ( ISTTAB.NE.2) GO TO 7786 

THE FOLLOMING EQUATIONS ARE THE 'THICK' SET 

GO TO (151,152, 153), IGEOM 

EQUATIONS FOR SHELLS OF REVOLUTION ( PHI COORDINATE ) 

151 CONTINUE 

YAOPH = XN*YPRED( 1+6 )*X 1R0-YPREDI I+4)*SN1R0 

YANTH » XNUPT* YPREO < I + l )♦ ( XKi 1-XNUPT**2*XK22 ) * ( ( XN*YPRED ( 1+4 )♦ 

1 YPREO( I+5)*CS-YPRED( I +6 )*SN )*X1R0+XI*YADPH*SAVY ( 9) ) + K* 

2 (XNUPT*XNTPH-XNTTH)+X2*(XNUPT*SAVY( ll)-SAVY(lO) ) 

3 +X3*SAVY(48> 

YAMTH = XNUPT*YPRED( 1+3 )-( XD1 1-XNUPT**2*XD22 >*X1 R0*( XlRO*( XN* 

1 YPREDl I+4)*SN-XNSQ*YPRED( 1+6) )+YPRED(I+7 )*CS)+K* 

2 (XNUPT*XMTPH-XMTTH )+X2* ( XNUPT*SAVY ( 14 ) -S AVY( 13 ) ) 

3 +X3*SAVY ( 49 ) 

YAMPT « (-1.0/( (RO/X033J+< SNSQ*X 1R0/XK33 > ) )*(-2. 0*XN* 


1 

2 

3 

4 

5 

YANPT 
YAJPH = 

1 

YD0TII+4) 

1 

2 

3 


YD0T( 1+5 ) 

1 


YPREDl I+7)+YPRED( 1+4 ) * (C SIR 1-CN1R0) +XN*Y PRED ( I +5 ) * 
(SNIR0+XIR1) +2.0*XN*YPRED( I+6)*CS1R0+YPRED( I )*SN/ 
XK33+X2*( SAVY ( 12 )*SN/XK33-SAVY( 15)*R0/XD33)+SN*X14 
l YAOPH*SAVY ( 5 )+SAVY( 9 ) * YPRED ( 1+7 ) ) ) 

♦X3*SAVY ( 50 ) 

YPREDl I )+YAMPT*SNlRO 

YPRED( I+2)+Xl*(SAVY( 8 )*YAOPH+YANPT*SAVY( 9)-YPRED( 1+1 ) 
♦SAVY ( 5 )-YPRED( 1+7 )«SAVY( 6 ) ) 

Rl* ( YPREDl 1+4 )4CS1R0+XN*YPRED( I+5)*X1R0+ YPREDl I ) /XK33+ 
X2* SAVY (12) /XK33+YAMPT*SN1R0/XK33 )+Rl*Xl ♦ ( YAOPH* 

SAVYl 5J+YPRE01 I+7)*SAVY(9) ) 

♦X3*SAVY( 51 ) 

Rl* ( YPREDl 1+6 )*XlRl+( 1. 0/1 XK22-XNUTP**2* XK11 )) * 

(YPREDl I+l )-XNUTP*YANTH+K* l XNTPH-XNUTP*XNTTH ) +X2* 


500000 

500010 

500020 

500030 

500040 

500050 

500060 

500070 

500080 

500090 

500100 

500110 

500120 

500130 

500140 

500150 

500160 

500170 

500180 

500190 

500200 

500210 

500220 

500230 

500240 

500250 

500260 

500270 

500280 

500290 

500300 

500310 

500320 

500330 

500340 

500350 

500360 

500370 

500380 

500390 

500400 

500410 

500420 

500430 

500440 

500450 

500460 

500470 

500480 

500490 

500500 

500510 

500520 

500530 

500540 

500550 

500560 

500570 

500580 

500590 

500600 


50 



OJ fv> ' i- tj) N M ^ WN H l» M i- M >- vn^WMH ^ W M H V* *• W M 


2 

3 

A = 

1 

8 = 

1 

YDOT ( I ) 

1 


YDOT < I + l ) 


YDOT ( 142 ) 


YOOT ( 1+3 ) 


YDOT ( 1+6) 
YDOT ( 1+7 ) 


( S AVY ( 1 1 )-XNUTP*SAVY( 10 ) > I )-Rl* YPRED < I +7 )*X1*SAVY(5) 
4X3*SAVY( 521 

YPRED< I45)*CS1R0-YPREDC 1+& > *SN1R0+SAVY «9 )*YA0PH4 
YDOT ( I+5I/R1-YPRE0C 1*6 ) /RL*SAVY< 5)*YPRED tl*7 ) 

SAVY( 1)*CSIRO-SAVY(3)*SN1R04.5*( SAVY< 9)* SAVY (9 ) 
4SAVY(5)*SAVY(5))4(SAVYt2l-SAVYt3))/Rl 
Ri*(-2.0*YPRED< I)*CS1R04XN*YANTH*X1R0-XN*YAMTH*SN* 
X1R0SQ-YAHPT*CS1R0*(X1R1-SN1RQ) )-Rl*K*<XFTHLD4XHPHLD* 
SNIR0)-RI*X1*<SAVY(24)*A4K*XFTHLD*B4SAVYI25)*YD0T(I44) 
/Rl4SAVY14)*K*XFPHLD/Rl4SAVY(26)*YA0PH4SAVY(9)*K* 
XFZEtD*-SN/R0*( YANTH*SAVY( 9 ) ♦YAOPH*SAVY (7 )-YPREDI t+7)* 
SAVY(8)-YANPT*SAVY(5) ) )-X3*SAVY( 33) 

Rl*( CS 1R0*< YANTH- YPRED t I* 1-1 )-XN*XlR0*< YPRE0III4 

YAHPT*( SN*X1R04X1R1) ) 4YPRED I 142 ) *X1R1 ) -R 1*K*XFPHLD 

-Rl*Xl*(SAVY(25)*A4K*XFPHtD*B 

-SAVY ( 26 ) *YPRE0( 147 )-SAVY ( 5 )*K*XFZELD ) 

-X3*SAVY ( 34 1 

Rl* ( -YPRED ( 142 ) *CS1R0-YANTH*SN1R0— YPREDC I41)*X1R1 
4XNSG*YAMTH*X1R0SQ-2.0*XN*YAHPT*CS*X1R0SG)4R1*K* 
<XN*XMPHL0*X1R0-XFZEL0>-R1*X1*(SAVY(26)*A4K*XFZELD* 
B-SAVY ( 24)*YA0PH-SAVY(9)*K* 

XFTHLD4SAVY( 25)*YPRED( 1 47 ) 4SAVY ( 5 )*K*XFPHLD) 

-X3*SAVY ( 35 ) 

R1*(YAMTH*CS1R0-YPRED( I43)*CS1R0-2.0*XN*YAHPT*X1R04 
YAJPH4K*XHTHL0) 

4X3*SAVY(36) 

Rl* ( YPRED ( 147 )-YPRED( I45)*X1R1) 

Rl*( 1.0/1 XD22-XNUTP** 2*XD1 1 ) )*t-YPRED< 14 3) 4XNUTP* 
YAMTH-K*(XHTPH-XNUTP*XMTTH)-X2*< SAVY 114) -XNUTP* 

SAVY ( 13) ) ) 

4X3*SAVY ( 53 ) 


GOTO 9005 

EQUATIONS FOR CONE 

CONTINUE 

YAOPH = XN*YPRE0( |46 ) *X ICS/S-YPRED II 44 ) *TAN/S 

YANTH = XNUPT*YPRED1 I41)4(XK11-XNUPT**2*XK22)*U X1CS/S)*(XN* 

YPRED( I44)4YPRED( I45)*CS-YPREDII46)*SN)4X1*YA0PH* 

SAVY < 9 ) )4K*(XNUPT*XNTPH-XNTTH)4X2*IXNUPT*$AVYI 11)- 
SAVYl 10) ) 

4X3*SAVY(48) 

YAMTH=XNUPT*YPRED( 1*3 )-( 1.0/S )*X1CS* (XD1 l-XNUPT**2*XD22 > * Ml -0/S ) * 
X1CS*( XN*YPRED( 144 )*SN-XNSQ*YPRED( 1*6 ) ) 4 YPRED! |47)*CS>- 
K*1XMTTH-XNUPT*XMTPH) 

4X2*«XNUPT*SAVY(14)-SAVY(13) ) 

4X3*S AVY ( 49 ) 

YAMPT = t-1.0/US*CS/X033)4(SN*TN/(XK33*S) ) > ) * (-2 . 0*XN*YPRED< 1 47 >- 

YPRED( I44)*SN/S4XN*YPRE0( 145 ) *TN/ S+2.0*XN*YPRE D( I46)/S*YPRED 
( 1)*SN/XK334X2*(SAVY( 1 2 ) *SN /XK33-SA VY ( 15 )*S*CS/XD33) 
4SN*X1*( YAOPH* 

SAVY ( 5 ) 4S AVY ( 9 ) *YPREDt 1*7) ) ) 

4X3*SAVY( 50) 

YANPT » YPRED(I)4YAMPT*TAN/S 

YAJPH = YPRE0(I42)4X1*(SAVY(8)*YA0PH4YANPT*SAVY(9)-YPRED(I41)* 

SAVY ( 5 )-YPRE0( 1 47 )*SAVY ( 6) ) 

YDOT ( 1 44 )= ( 1.0/S)*(YPRED( 1 44 )4XN* YPRED ( 1 45 ) * X1CS4 Y AMPT*TN/XK33 ) 
4YPRED( X)/XK334X2*SAVY( 12)/XK334X1*1YA0PH*SAVY(5) 
4YPRED1 147 )*SAVY{ 9 ) ) 

4X3*SAVY( 51) 

Y00TU45) = (1.0/<XK22-XNUTP**2*XKll))*«YPREDU4l)-XNUTP*YANTH4 

1 K*t XNTPH-XNUTP*XNTTH) 4X2* ( SA VY ( 1 1 )-XNUTP *SAVYC 10 ) ) ) 

2 -YPRED( I47)*X1*SAVYI5) 


500610 

500620 

500630 

500640 

500650 

500660 

500670 

500680 

500690 

500700 

500710 

500720 

500730 

500740 

500750 

500760 

500770 

500780 

500790 

500800 

500810 

500820 

500830 

500840 

500850 

500860 

500870 

500880 

500890 

500900 

500910 

500920 

500930 

500940 

500950 

500960 

500970 

500980 

500990 

501000 

501010 

501020 

501030 

501040 

501050 

501060 

501070 

501080 

501090 

501100 

501110 

501120 

501130 

501140 

501150 

501160 

501170 

501180 

501190 

501200 

501210 


51 



c 


3 

1 

1 

1 

2 

3 

4 

5 

1 

2 

3 

1 

2 

3 

4 

1 

2 


1 

2 


♦X3*SAVYt52> 

A - YPREOt I*5)/S-YPREDtI*6»*TN/S*SAVYt9)*YAOPH*YDOTt 1+5* 

♦SAVY (5)*YPRED< 1+7) 

B * SAVYll)/S-SAVYt3)*TN/S*0.5*lSAVYt9>*SAWt9>*SAVYt5l* 

SAVY I 5 ) l*SAVYl 2 ) 

YOOT(I) »-2.0*YPRE0t n/S*XN*YANTH*XlCS/S-XN*YAMTH*SN*XlCS**2/S**2 
♦YAMPT*TAN/S**2-K*tXFTHLD*XMPHLD*TAN/S)-Xl*tSAVYt24>* 
A*K*XFTHLO*B+SAVYt 25 1*YDQT ( I +4 l + SAVY t4 )*K*XFPHL0* 

SAVY (26 )*YAOPH*SAVY 1 9 ) *K*XFZELD+TAN/S* tY ANTH*SAVYt 9) ♦ 
YAOPH*S AVY t 7 I-YPREDt 1*7 )*SAVY( B t-YANPT*SAVYt 5 J >)-X3* 
SAVY t 33 ) 

YOOT 1 1 *1 ) = -YPRED l 1 +1 )/S*YANTH/S-XN*YPREDt I )/( S*CS >- XN*YAMPT*SN/ 
t S*S*CS*CS J-K*XFPHLD-X 1* t $AVY( 25 ) *A+K*XF PHLD*B- 
SAVY ( 26 )*YPREDC 1*71- SAVY t 5)*K*XFZELD> 

-X3*SAVYt 34 ) 

YOOT M +2 ) <* -YPREOt 1+2 t /S-YANTH*TAN/S*XNSQ*YAMTH/t S**2*CS**2 ) 

-2.0*XN*YAMPT/tS**2*CS)*K*<XN*XHPHL0*XlCS/S-XFZELD) 
-Xl*tSAVYt26l*A*K*XFZELD*B-SAVYt24)*YA0PH-SAVYl9)*K* 
XFTHLO+SAVYt 25 1 *YPREDt I*7)+SAVY< 5)*K*XFPHLD> 

— X34SAVYI 35 ) 

YOOT 1 1 + 3 I* YAMTH/S- YPRED l 1*3 ) /S-2 .0*XN*YAMPT/1 S*CS )+ YA JPH+XMTHLD 
♦K 

♦X3*SAVYt 36 ) 

YOOT ( I*6l*YPRE0t 1+7) 

YOOT tl*7)=tl.0/t XD22-XNUTP**2*XD1 1 J ) * t -YPRED ( I*3I*XNUTP*YAMTH- 
K*l XMTPH-XNUTP*XMTTH )-X2* t SAVY t 14 )-XNUTP*SAVYt 13 H) 
♦X3*SAVYt53> 


GO TO 9005 

EQUATIONS FOR CYLINDER 
153 CONTINUE 

YAOPH = XlRO*t XN* YPREOt 1*6 )- YPRED t 1*4) ) 

YANTH * XNUPT*YPRED( 1 + 1 )♦ t XK l 1-XNUPT**2*XK22 )* t t X1R0* t XN* 

1 YPREOt I*4)-YPRED( I+6I) )+Xi*YA0PH*SAVYt9) )*K*(XNUPT* 

2 XNTPH-XNTTH ) *X2*l XNUPT*SAVY tll)-SAVY(lO) ) 

3 *X3*SAVYt48) 

YAMTH=XNUPT ♦YPREOt I +3 )-l X 1R0* t XD1 1- XNUPT**2*XD22 ) )♦( X1R0* t XN*YPRED 

1 t I+4)-XNSQ*YPREDt 1+6) ) ) +K* l XNUPT*XMTPH-X NTTH ) 

2 *X2* t XNUPT*SAVY 1 14 ! -SAVY 1 13 I t 

3 *X3*SAVYt 49 ) 

YAMPT= t-1 .0/ 1 1 R0/X033 1 + 1 X1R0/XK33 1 1 1* t-2 .0*XN*YPREDt I*7i +XN*X1R0* 


1 

2 

3 


YANPT 
YAJPH '■ 
l 

YDOTt 1+4 » 


1 

2 

1 

2 

3 


YDOTt 1+5) 


A ». 


YDOTt 1 1 


1 

2 

3 

4 


YPREOt 1+5 )*YPREDt I >/XK33*X2* ( SAVYt 12 >/XK 33-S AVY t 15 )♦ 
RO/ XD33 ) +X 14 1 Y AOPH*S AVY t 5 ) *SAVY 1 9)*YPRED 1 1*7 1 1 1 
♦X3*SAVYt 50 I 
YPREOt 1 )*YAMPT*X1R0 

YPREOt 1*2 )+X 14 1 SAVY t 8 )*YAOPH*YANPT*SAVYt 9) -YPRED 11*11 
♦SAVY t 5 )-YPREOt I*7)*SAVYt6) ) 

XN*YPREOt 1*5 )*XlRO+YPREDt I ) /XK33+X2*SAVY 1 121/XK33* 
YAMPT*X1R0/XK33+Xl*t YAOPH*SAVYt 5>*YPREDt I+7)*SAVY19) » 
♦X3*SAVYt 51 1 

tl.0/tXK22-XNUTP**2*XKll ) > * t YPRED t I* 1 )-XNUTP*YANTH+ 
K*tXNTPH-XNUTP*XNTTH)*X2*t SAVVf 1 U- XNUTP*SAV Yt 10 »H- 
YPREOt I*7)4X1*SAVY(5) 

♦X3*SAVYt 52 1 

-YPREOt I*6J/R0*SAVYt9) *YAOPH*YOOTt I*5>*SAVYt5>* 

YPREOt 1*7 » 

—SAVY ( 3 )/R0*0. 5*t SAVY 1 9>*SAVY( 9 ) *SA VY 1 5) *SAVYt5> )♦ 

SAVY 12) 

XN*YANTH*X1R0-XN*YAMTH*X1R0SQ-K*(XF THLD* XMPHLD*X1R0» 
-Xl*t$AVYl24)*A*K*XFTHLD*B*SAVYI25>*YD0T 1 1 *4 )*SAVY 14)4 
K4XFPHLD+SAVY t 26 >4YA0PH*SAVYt9»4K*XFZELD*t YANTH* 
SAVYt9)*YA0PH*SAVYt 7)-YPRED( 1 + 7 >*SA VY t 8) - YANPT* 

SAVY t 5 ) )/R0 )-X3*SA VY I 331 


501220 
501230 
501240 
501250 
501260 
501270 
501280 
501290 
501300 
501310 
501320 
501330 
501340 
501350 
501360 
501370 
501380 
501390 
501400 
501410 
501420 
501430 
501440 
50 1450 
501460 
501470 
501480 
501490 
501500 
501510 
501520 
501530 
501540 
501550 
501560 
501570 
501580 
501590 
501600 
501610 
501620 
501630 
501640 
501650 
501660 
501670 
501680 
501690 
501700 
501710 
501720 
501730 
501740 
501750 
501760 
501770 
501780 
501790 
501800 
501810 
601820 
501830 


52 



YDOT I 

1 

2 

3 


YDOT ( 


1 

2 

3 


YDOT ( 


YDOT ( 
YDOT ( 

1 

2 


I + l) = -XN*X1R0*YPRED( I)-XN*YAMPT*X1R0SQ-K*XFPHLD-Xl* 

ISAVY(25)*A+K*XFPHLD*B-SAVYI26)*YPRED(I+7) -SAVYI 5) * 
K*XFZELD> 

— X3*S AVY (341 

1+2) = — YANTH*X1R0+XNSQ*YAMTH*X 1ROSQ+K* I XN*XHPHLD*X1R0- 
XFZELD)-X1*(SAVY(26)*A+K*XFZELD*B-SAVY(24J*YA0PH- 
SAVYI 9 ) *K*XFTHLD+SAVYI 25 )*YPRED (1+7 ) + SAV Y( 5) *K*XFPHLD) 
-X3*SAVY(35) 

1+3) = -2. 0*XN*YANPT*X 1RO+YA JPH+K*XMTHLD 
♦X3*S AVY ( 36 ) 

I+6)=YPRED( 1+7) 

1+7) = <1.0/(X022-XNUTP**2*XDll)>*(-YPRED(I+3)+XNUTP*YAMTH+ 
K*( XNUTP*XMTTH-XHTPH)-X2*I SAVYC 14 )-XNUTP*SAVYt 13 ) ) > 
♦X3*S AVY I 53 ) 


GO TO 9005 

7786 GO TO (4771,4772.4773 ), IGEOM 
C THE FOLLOWING EQUATIONS ARE THE 'ST10* SET 

C EQUATIONS FOR SHELLS OF REVOLUTION ( PHI COORDINATE 
4771 CONTINUE 
YAOPH 
YANTH 


) 


= XN*YPREOI I+6)*X1R0-YPRED(I+4)*SN1R0 
= XK12*< 1.0/1 XK22+XC22**2/XD22) )*( YPRED 1 1* l ) +K*XNTPH+ 
l X2*SAVY< 11)+(XC22/XD22)*(YPRED( I +3) +K*XMTPH+X2* 

•1 SAVY ( 14 )) ) -K*XNTTH-X2*SAVY I 10)+(X1R0*XK1 1- 

1 XK12*XK21*X 1R0*( 1.0/ 

2 IXK22+XC22**2/XD22) ) )*<XN*YPRED( 1+4 > +YPREDI 1+ 5 ) *CS-YPRED( 1+ 

3 6 ) *SN+X1*R0*YA0PH*SAVY( 9 ) )- ( XC l 1+XK 12*XC 22*XD21 /XD22* 

3 ( 1.0/ ( XK22+XC22**2/XD22 ) ) )* 

4 IXiR0**2*(XN*YPRE0tI+4) *SN-XN**2*YPRED I I+6))+YPRED(I+7)*CS* 

5 X 1R0) 

6 +X3*S AV Y ( 48 I 

YAHTH - -XD12*(XC22/IXC22**2+XK22*XD22) )*(YPRED( 1+ 1 ) +K*XNTPH+ 

1 X2*SAVY(11J )-K*XMTTH-X2*SAVY(13)+XDlZ*(Xk22/(XC22**2+ 

2 XK22*XD22))*IYPRE0( 1+3 ) +K*XMTPH+X2* SAVYI 14))+<XC11* 

2 XlRO+XO12*XK21*XlR0*(XC22/(XC22**2+XK22*XD22 ) ) ) * I XN*YPRED( 

3 I+4)+YPRED( I+5)*CS-YPRE0(l+6)*SN+Xl*R0*YA0PH*SAVY(9) )+ 

3 (XDU-XD12*XK22*XD21/l 

4 XC22**2+XK22*X022I ) * I X 1R0SQ*( XN* YPRED 1 1 +4) *S N-XNSQ*YPRED 

5 I I+6))+YPRE0(I+7)*CS*XiR0) 

6 +X3*SAVY( 49) 

YAMPT = (-1.0/1 I RO/X033 )+(SN5Q*XlR0/XK33) ) )* 1-2. 0*XN* 

1 YPRED( I+7)+YPRED( 1+4) * I CSIR l-CNIRO) +XN*Y PRED I 1+5)* 

2 (SN1RO+X1R1)+2.0*XN*YPRED( I +6 ) *C S 1R0+YPR ED 1 1 )*SN/ 

3 XK33+X2*(SAVY( 1 2 ) *SN/XK33-SAVY I 15 )*R0/XD33 )+SN*Xl* 

4 (YAOPH* SAVYI 5)+SAVY(9)*YPRED(I+7) ) ) 

5 +X3*SAVY ( 50 ) 

YANPT = YPREDl I ) +YAMPT*SN 1R0 

■YAJPH = YPREDl I +2 )+X 1* ( SAVYI 8 I * YAOPH+YANPT*SAVY( 9) -YPREDl I + l ) 

1 *S AVY (5) -YPREDl I + 7)*SAVY(6) ) 

YDOT 1 1+4) = Rl* I YPREDl 1+4 )*CS XRO+XN* YPREDl 1 + 5 )*X1R0+ YPREDl I ) /XK33+ 

1 X2*SAVY 1 12 ) /XK33+YAHPT*SN1R0/XK33 ) +R l*Xl * I YAOPH* 

2 SAVY(5)+YPREDII+7)*SAVYI9)) 

3 +X3*SAVY I 51 ) 

YDOT I 1+5 ) = R 1*1 YPREDl 1 + 6 )*X1R l-Xl* YPRED 1 1 + 7 ) *SAVY 15 )♦ 1 1 .0/ 1 XK22+ 

1 XC22**2/XD22) )*( YPREDl I ♦ 1 )+K*XNTPH+X2*SA VY I 11 )+(XC22/ 

1 XD22)*(YPREDI 1+3) +K*XMTPH+X2*S AVY (14))-XK21*X1R0*(XN* 

2 YPREDl I+4)+YPRED( I + 5 ) *C S-YPRED I I +6 ) *SN )- X1*XK12*YA0PH* 

2 SAVY(9)-IXC22*X021/XD22 

3 )*(X1R0SQ*(XN*YPRED( 1+4 ) *SN-XNSQ*YPRED( 1+6) )+YPREDI 1+7) 

4 *CS*X 1R0 ) ) ) 

5 +X3*SAVY I 52 ) 

A = YPRED 1 1 +5 )*CS IRQ- YPREDl 1+6 ) *SN1R0+SAVY (9 )*YAOPH+ 


53 : 


501840 

501850 

501860 

501870 

501880 

501890 

501900 

501910 

501920 

501930 

501940 

501950 

501960 

501970 

501980 

501990 

502000 

502010 

502020 

502030 

502040 

502050 

502060 

502070 

502080 

502C90 

502100 

502110 

502120 

502130 

502140 

502150 

502160 

502170 

502180 

502190 

502200 

502210 

502220 

502230 

502240 

502250 

502260 

502270 

502280 

502290 

502300 

502310 

502320 

502330 

502340 

502350 

502360 

502370 

502380 

502390 

502400 

502410 

502420 

502430 

502440 



1 

1 

1 

2 

3 

4 

5 

1 

2 

3 

4 

1 

2 

3 

4 

5 

1 

2 


1 
1 

2 

3 

4 

5 


YDOT ( 1+5) /R1-YPRE0 ( 1+6 ) /Rl+S AVY C 5 ) +YPRED I 1+7 ) 

B = SAVYI1)*CS1R0-SAVYI3)*SN1R0+.5MSAVY|9)*SAVYI9> 

+SAVY I5)*SAVYI5))+ISAVYI2)-SAVYI3))/R1 

YOOtm = Ri*l-2.0*YPREDl I )*CS1R0+XN*YANTH*X1R0-XN*YAMTH*SN* 

X1ROSA-YAMPT *CS 1RO+I X 1R 1-SN1RO ) )-Rl*K* (X FTHLD+XMPHLD* 
SN1RO >-Ri*X 1*1 SAVY I 24)*A+K*XFTHLD*B+SAVY 125) *YDOT I 1+4) 
/Rl+SAVYI 4 )*K*XFPHLD/R1+SAVY ( 2 £> > +YAOPH+S AVY 1 9) *K* 
XFZELD+SN/RO*(YANTH*SAVY(9)+YAOPH*SAVY(7 )-YPRED 1 1+7 >* 
SAVYI 6)-YANPT*SAVYI5) ) ) -X3* SAVY 1 33 ) 

YDOTII+1) = R1MCS1ROM YANTH-YPREDI I+l ) )-XN*XlRO*l YPREDI I )♦ 

YAMPTM SN*X1R0+X1R1) ) +YPREDI 1+2 )*X1R1 )-R 1*K*XFPHLD 
-R1*X 1*1 SAVY I 25 l*A+K*XFPHLO*B 
-SAVYI26)*YPRED<I+7)-SAVYI5)*K*XFZELD) 

-X3*SAVYI34) 

YOOTII+2) = R1M-YPREOI I +2 )*C S1RO-YANTH*SN1RO-YPREDI I+1)*X1R1 
♦XNSQ*YAMTH*X1ROSQ-2.0*XN*YAMPT*CS*X1ROSQ)+R1*K* 

( XN*XMPHLD*X 1RQ-XFZELD ) -R1 *X1* I SAVY ( 26 )* A+K*XFZELD* 
B-SAVYI 24 )*Y AOPH— SAVY l 9 )*K* 

XFTHLD+SAVY ( 25 ) *YPRED l I +7) +SAVY l 5 )*K*XFPHLD> 

-X3*SAVYI 35 I 

YDOT ( 1 + 3 ) = Rl*IYAMTH*CSlR0-YPREDII+3) *C S1RO-2. 0*XN* YAMPT*X1R0+ 
YAJPH+K*XMTHLO 1 
♦X3*SAVY( 36 ) 

YDOT ( 1+6 ) = R1MYPREDI I + 7)-YPREOI I+5)*X1RI) 

YDOT l 1+7 1 * RIM I-XC22/IXC22**2+XK22*XD22> > * l YPRED II +1 > +K*XNTPH+ 
X2*SAVYIll)-(XK21/RO)*|XN*YPRED{I+4)+YPREDII+5)*CS- 
YPREDI I +6 ) *SN )-Xl*XK 12*YAOPH*SA VY 19) ) + (XK22/ ( XC22**2+ 
XK22+XD22) ) * I YPREO ( 1+3 )+K*XMTPH+X2*SAVYI 14) )-IXK22* 
X021/IXC22**2+XK22*X022) )*l XIROSQ* t XN*YPRE Dl 1+4 > *SN-XNSQ 
*YPREDI 1+6) )+YPREDI 1+7 ) *CS*X IRD) ) 

♦X3*SAVYI 53) 


GO TO 9005 

C EQUATIONS FOR CONE 

4772 CONTINUE 

YAOPH = XN*YPRED( 1*6 ) *X 1C S/S- YPRED II+4)*TAN/S 

YANTH = XK 12*11. 0/IXK22+XC22**2/XD22))*IYPREDII+ 1 )+K*XNTPH+ 

I X2*SAVYI 11 )+<XC22/X022)M YPREDI I+3)+K*XHTPH+X2* 

1 SAVYI 14) ) )-K*XNTTH-X2*SAVY ( 10)+ I 1.0/(CS*S) ) 

1 * ( XK 1 1— XK 12*XK2 1* I 

2 1.0/(XK22+XC22**2/XD22 J ) )*IXN*YPREDI I+4)+YPREDI I+5)*CS- 

3 YPREDI I+6)*SN+X 1*S*C S* YAOPH* SA VY 19) )-( XC 11+ C XK12+XD21* 

3 XC22/XD22)M 1.0/IXK22+XC22* 

4 +2/XD22) ) )*< ll.0/IS**2*CS**2>)*(XN*YPREDII+4)*SN-XNSQ*YPRED 

5 ( 1+6) )+YPRED(I+7)/S) 

6 +X3*SAVY( 48 » 

YANTH = -XD12*(XC22/(XC22**2+XK22*XD22) )* I YPREDI 1+1) +K+XNTPH+ 

1 X2*SAVYI 11 ) )-K*XHTTH-X2*SAVYI 13 )+XD12* IXK22/ I XC22**2+ 

1 XK22*XD22)J*IYPRE0I I+3)+K*XMTPH+X2*5AVYI 14) ) + (XCll/ 

2 (S*CS)+XD12*XK21/IS*CS) ) * I XC22 / I XC22**2 + XK22*X022) )*IXN* 

3 YPREDI 1+4 )+YPRED( I+5)*CS- YPREDI 1+6)* SN+X 1* SMS* YAOPH* 

3 SAVYI9) )♦( XD11-XD12*XK22* 

4 X02l/IXC22**2+XK22*XD22) )*ll 1 . 0/ 1 S*C S )**2 ) *1 XN*YPRED 1 1+4 >* 

5 SN-XNSQ* YPREDI 1+6 ) ) +YPREDI I +7 ) / S ) 

6 +X3+SAVYI 49 ) 

YANPT=I-1.0/I I S*C$/XD33 ) ♦ l SN*TN/ l XK33*S ) ) ) ) * 1-2 . 0*XN*YPREDI I +7 )- 

1 YPREDI 

2 

3 

4 

5 

YANPT 
YAJPH = 


I+4)*SN/S+XN*YPREDI I +5 ) *TN/ S+2. 0*XN*YPRE Dl 1+6 ) /S+YPRED 
I I )*SN/XK33+X2*( SAVY I 12 )*SN/XK33-SAVY( 15 )*S*CS/XD33) 
♦SN*X 1*1 YAOPH* 

SAVYI5)+SAVYI9)*YPRED(I+7)) ) 

♦X3*SAVYI 50) 

YPREDI I)+YAHPT*TAN/S 

YPREDI I +2 ) + Xl*(SAVY( 8 )*YAOPH+YANPT*SAVYI 9)-YPRED I I + l )* 


502450 

502460 

502470 

502480 

502490 

502500 

502510 

502520 

502530 

502540 

502550 

502560 

502570 

502580 

502590 

502600 

502610 

502620 

502630 

502640 

502650 

502660 

502670 

502680 

502690 

502700 

502710 

502720 

502730 

502740 

502750 

502760 

502770 

502780 

502790 

502800 

502810 

502820 

502830 

502840 

502850 

502860 

502870 

502880 

502890 

502900 

502910 

502920 

502930 

502940 

502950 

502960 

502970 

502980 

502990 

503000 

503010 

503020 

503030 

503040 

503050 

503060 
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L SAVY (5)-YPRE0( 1+7)* SAVY (6) ) 

YDOT( 1+4 )=( 1.0/S>*< YPREDl 1+4) +XN*YPREDI 1+5 ) *XICS+YAH PT*T N/XK33 ) 
♦YPREDl I >/XK33+X2*SAVYI 12)/XK33+X1*I YAOPH* SAVY 15) 
♦YPREDl l+7)*SAVYI9)> 

♦X3*SAVY1 51 ) 

YOOTII+5) = -Xl*YPREDII+7)*SAVY<5)+tl.0/IXK22+XC22**2/XD22>)* 

( YPREDl I+1)+K*XNTPH+X2*SAVYI11)+(XC22/XD22 >* 

IYPREOI I+3)+K*XMTPH+X2*SAVY(14> )-(XK21/l S*CS))*IXN* 
YPREDl I +4 )+YPREDI 1+5 )*CS-YPREDt I +6) *SN )- X1*XK12*YA0PH* 
SAVY ( 9)-( XC22+XD2 1/X022)* I ( 1.0/ ( S**2*CS** 

2 ) )*l XN*YPRED I I+4)*SN-XNSQ*YPREDI 1+6) l+YPR ED 1 1 +7 )/S ) ) 
♦X3*SAVYI52) 

A = YPRED( I+5)/S-YPRED( I +6 >*TN/S+SA VY 1 9 > *YA0 PH+YDOT 1 1+5 ) 

L +SAVY( 5)* YPREDl 1+7) 

B = SAVY<l)/S-SAVYI3)*TN/S+0.5*<SAVYI9)*SAVY(9)+SAVYI5)* 

L SAVY ( 5) )+SAVY(2) 

YDOTC I ) =-2.0*YPRE0< l ) /S+XN* YANTH*X1CS/S-XN*YAMTH*S N*X1 CS**2/S**2 

+YAMPT*TAN/S**2-K*IXFTHLD+XHPHLD*TAN/S)-Xl*l SAVY 1 24)* 
A+K*XFTHLD*B+SAVY125)*YD0TI 1+4 ) +SAVYI 4 )* K*XFPHLD+ 

SAVYI 26 ) *YAOPH+ SA VYI 9) *K*XF ZELD+TAN/S* I Y ANTH*SAVY(9) ♦ 
YAOPH*SAVY I7J-YPREDI 1+7 )*SAVY 1 8 ) -YANPT*S AVY1 5 > ) )-X3* 
SAVYI 33 ) 

YDOTII+1 )= -YPREOI I+l )/S+YANTH/S-XN*YPRED( I ) / I S*CS )- XN*YAMPT*SN/ 
IS*S*CS*CS)-K*XFPHLD-X1*ISAVYI25)*A+K*XFPHL0*B- 
SAVY(26)*YPRE0I 1 + 7 )-SAVY I 5 ) *K*XFZELD ) 

-X3*SAVY( 34 ) 

YDOTII+2) > -YPREDl I+2)/S-YANTH*TAN/S+XNSQ*YAMTH/IS**2*CS**2) 

— 2. 0*XN*Y AMPT/ I S**2*CS ) +K* I XN*XMPHLD*X1C S/S-XFZELD) 
+X1*ISAVYI26 )*A+K*XFZELD*B-SAVY 124) *YAQP H-SA VY (9 ) *K* 
XFTHLO+SAVY I 25 ) *YPREDI 1 + 7 ) +SAVY I 5 ) *K*XFPHLD ) 

-X3*$AVY I 35 ) 

YDOT ( 1+3 )= YAMTH/S-YPREDI 1+3) /S-2.0*XN*YAMPT/I S*CS)+ YAJPH+XMTHLD 
*K 

+X3*S AVY 136) 

YD0TII+6)=YPREDI 1+7) 

YDOT 11+7) = -1XC22/IXC22**2+XK22*XD22))*IYPRED1I+1)+K*XNTPH+X2* 

X SAVYI 11 )-XK21*IXN*YPREOI I+4)+YPREDI 1+5 )*CS-YPRED ( I +6 )* 

1 SN) / I S*CS )-X 1*XK 12*YAOPH*SAVYI 9 ) ) + l XK22/ I XC22**2+XK22* 

2 XD22) )*( YPREOI 1 + 3 ) +K*XMTPH+X2*SA VY I 14 ) )- IXK22*XD21 

3 /IXC22**2+XK22*XD22) 1*1 I l.O/l S*C S ) **2 ) *1 XN*YPRED 1 1 +4 ) *SN 

4 -XN**2*YPREDI 1+6) l+YPREDI I+7)/S) 

5 +X3*SAVY 153) 

GO TO 9005 

S EQUATIONS FOR CYLINDER 
4773 CONTINUE 

YAOPH = XI RO*IXN* YPREDl I+61-YPREDI 1+4) ) 

YANTH = XK12*I1.0/IXK22+XC22**2/XD22) )* I YPRED 1 1+ 1 )+K*XNTPH+ 

1 X2*SAVY (11)+ 

l IXC22/X022)*IYPRED(I+3) + K*XHTPH + X2*SAVYI 14) ) )-K*XNTTH- 

1 X2*SAVYI10)+IXiRO*IXKll-XK12*XK21*I 1.0/1 XK22+XC22**2/ 

2 XD22) )) )*IXN*YPRE0(I+4)-YPREDII+6) + Xi*R0*YA0PH* 

2 SAVY (9) )-(XCll+l 

3 XK12*XC22*XD21/X022)*ll.0/IXK22+XC22**2/XD22) ) ) * { X1R0**2* I 

4 XN*YPRED( 1+4 )-XNSQ*YPREDl 1+6) ) ) 

5 +X3*SAVY I 48 > 

YAMTH = -XD12*IXC22/(XC22**2 + XK22*XD22) )*IYPREDI I + l ) +K*XNTPH+ 

1 X2*SAVYI 11) )-K*XHTTH-X2*SAVYI 13 ) +XD 12* I XK22/ I XC22**2+ 

2 XX22*XD22) )*l YPREDl I +3 ) +K*XMTPH+X2* SA VYI 14) ) + IXCll* 

2 X1R0+XD 12*XK2 i*X 1R0* 1 XC22 / I XC22**2+XK22*XD22 ) I )*1XN*YPRED 

3 1 1+4 )-YPREDI 1+6 ) +X 1*R0* YAOPH* SAVY I9)) + (XD11-XD12*XK22* 

3 XD2 1/ I XC22**2+XK22*XD22) 


1 

2 

3 

4 

5 

■ > 
1 
2 
3 

> 

1 

2 

3 

4 

1 

2 


503070 
503080 
503090 
503100 
503110 
503120 
503130 
503140 
503150 
503160 
503170 
503180 
503190 
503200 
503210 
503220 
503230 
503240 
503250 
503260 
503270 
503280 
503290 
503300 
503310 
503320 
503330 
503340 
503350 
503360 
503370 
503380 
503390 
503400 
503410 
503420 
503430 
503440 
503450 
503460 
503470 
503480 
503490 
503500 
503510 
503520 
503530 
503540 
503550 
503560 
503570 
503580 
503590 
503600 
5036 10 
503620 
503630 
503640 
503650 
503660 
503670 
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4 )*IXXROSQ*IXN*YPRED< I+4)-XNSQ*YPREDt 1+6))) 

5 +X3*SAVY<49) 

YAMPT= I -1.0/ 1 1 R0/XD33 )+l XXR0/XK33 ) ) )*I-2.0*XN*YPREDI 1*7) +XN*XXR0* 

1 YPREO( I +5 )+YPRED I I) /XK33+X2*! SAVY (12 ) /XX 33-SAVYI 15 ) * 

2 RO/XD33 )+XX* I YAOPH*SAVY (5)+SAVYI9)*YPREDII+7)) > 

3 +X3*S AVY ( 50 1 

YANPT = YPREOI I )+YAMPT*XXRO 

YAJPH = YPREDII+2)+XX*ISAVYI8)*YA0PH+YANPT*SAVYI9)-YPRED<I+X) 

1 *SAVYI5)-YPRED( I+7)*SAVY(6) ) 

YDOTII+4) = XN* YPREOI 1 + 5 )*X XRQ+YPREO I I)/XK33+X2*SAVY(X2) /XK33+ 

1 YAHPT*XXR0/XK33+XX*I YAOPH*S AVY I 5 1 + YPREDI I+7)*SAVYI9) ) 

2 +X3*SAVY I 5X ) 

YDOT ( 1+5 ) = -XX*YPREDII+7)*SAVYI5)+IX.0/(XK22+XC22**2/XD22>)* 

1 (YPRED! 1+X)+K*XNTPH+X2*SAVYIIX)+(XC22/XD22>* 

2 ( YPRED( I+3)+K*XMTPH+X2*SAVY(X4) > - 1 XK2X*X XRO > * I XN* 

3 YPREOI 1+4 J-YPREDI 1+6) )-XX*XKX2* YAOPH*SAV Yl 9 ) - ( XC22* 

4 XD2X/XD22)*(XXR0S0*IXN*I YPREOI 1+4 J-XN*YPRED I 1+6) ) ) ) ) 

5 +X3*SAVY ( 52 ) 

A = -YPRE0(I+6)/R0+SAVYI9l *Y AQPH+YOOT 1 1 +5) +S AVYI 5 ) * 

1 YPREOI 1+7) 

B = -SAVYI3)/R0+0.5*( SAVY (9)*SAVY(9)+SAVY(5)*SAVY(5) )+ 

1 SAVY 1 2 ) 

YDOT II) * XN*YANTH*XXRO-XN*YAHTH*XXROSQ-K*tXFTHLD+XMPHCD*XXRO> 

X -XX*I SAVYI 24 )*A+K*XFTHLD*B+SAVY(25) *YDOT 1 1+4 )+SAVY(4 )* 

2 K*XFPHLD+SAVY 126) *YAOPH+SAVY 1 9 ) *K*XFZ£LD+ I YANTH* 

3 S AVYI 9) +YAOPH*S AVYI 7)- YPREOI 1+7) *SAVYI 8) -YANPT* 

4 SAVY I5))/R0)-X3*SAVYI33) 

YOOTII + 1) = -XN*X 1R0*YPRED(I) -XN*YAMPT*X1R0SQ-K*XFPH LD-X X* 

X I SAVY 1 25 ) *A+K*XFPHL 0*8- SAVY 1 26 ) * YPRED I I+7)-SAVYI 5)* 

2 K*XFZELO ) 

3 -X3*5AVY( 34 ) 

YDOT 1 1 + 2 ) = -YANTH*XXRO+XNSQ*YAMTH*XXROSQ+K*tXN*XMPHLD*XXRO- 
X XFZ ELD )-XX*( SAVYI 26 I *A+K*XFZELD*B-SAVY 12 4) *Y AOPH- 

2 SAVY 1 9) *K*XFTHLD+SAVY 1 25 l*YPREDI 1+7 )+SAVY(5) *K*XFPHLD) 

3 -X3*S AVY 135) 

YOOTII+3) = — 2.0*XN*YANPT*XXR0+YA4PH+K*XMTHLD 
X +X3*SAVYI 36 ) 

YDOT I I +6 )=YPRED( 1+7) 

YDOT I 1+7 ) = -I XC22/ 1 XC 2 2 ** 2+XK 2 2* X02 2) )* I YPRED I I + X )+ K*XNTPH+X2 * 

X SAVYI XX )-XK2X*X XRO* t XN* YPRED 1 1+4 )- YPRED! 1+6) )-XX*XKX2* 

X YAOPH*SAVY(9))+(XK22/(XC22**2+XK22*X022> ) * ( YPRED 1 1 + 3 ) + 

2 K*XMTPH+X2*SAVY I X4 ) )- 1 XK22*XD2 X / I XC22**2 + XK22*XD22 ) ) * I 

3 XXROSQ*IXN*YPREOl 1+4 )-XNSQ* YPRED I I +6 ) ) ) 

4 +X3*SAVY < 53 ) 


9005 CONTINUE 
RETURN 
END 


503680 

503690 

503700 

5037X0 

503720 

503730 

503740 

503750 

503760 

503770 

503780 

503790 

503800 

5038X0 

503820 

503830 

503840 

503850 

503860 

503870 

503880 

503890 

503900 

5039X0 

503920 

503930 

503940 

503950 

503960 

503970 

503980 

503990 

504000 

5040X0 

504020 

504030 

504040 

504050 

504060 

504070 

504080 

504090 

504X00 

504XX0 

504X20 

504X30 

504X40 
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FOR, IS 0IFF2.0IFF2 

C ROUTINE ** OIFF2 ** ABACUS UPDATED 01/11 /74 

SUBROUTINE D1FF2 
INTEGER SAVJTC,SAVSTP,Q, THICK 
INTEGER XNl.XN 
REAL K 

D0U8LE PRECISION YPREO 

COMMON STORY 1 16) ,XMAT( 270, 10), STD ( 10 ) , SADUS 1 30) ,RA0US(30) 

'COMMON TADUS (30 ) ,UADUS( 30 ) , SAVTIC ( 900) 

COMMON XN, TEFREE.TIC, PHI, STOP, RESTOP, RTICK, Gi, XNL(3) ,NH 
COMMON NST(30),NKL(30),NXMAT(20) ,SAVJTC(30) ,SAVSTP(30) ,JRTIC(30J 
COMMON JRST0P(30),NREG,NMPT«NRC,NSC«NIX, IERROR, KGEQM ,IGEOM,ISTTAB 
COMMON KELVI N, I BEGIN, NPROB,NSEG,NERROR,Q, THICK, NOJS, NLINKS.NLCASE 
COMMON NT,SKL,NZ ,NBCT,L INPUT ,NTRKL,NPASS,XN1 , KBC ,NR INGS 
COMMON LODE, ICYCLE,LDISTL 

COMMON /EQUAZN/ YPRE0( 72 ) , YDOT ( 72 > , YASA VE ( 72 ) , 

1 YANTH.YAMTH, YAMPT , YAJPH, 

2 S, SN,CS, SNSQ.CSSQ ,T AN, SEC ,CN ,X1CS, XI SN ,TN, 

3 X1RO,X1ROSO,X1SNRO, X1CSR0,CN1R0 ,SN1R0,CS1R0, 

4 X1R1,X1R2,CS1R1,CS1R2,SN1R1,X1R1SQ,R2SQ,R0,BESQ, 

5 R0SQ,XNSQ,BETA«R1,R2, S1.R1DOT, 

6 XNTTH,XNTPH,XMTTH,XMTPH,XFTHLD, XFPHLD.XF ZELD, 

7 XMTHLD, XMPHLD, ETHET,EPHI,XGPT,ALPHTH ,ALPHPH, 

8 XNUTP,XNUPT,XC11,XC22,XC15,XD33,XD22 ,XD21,XD12, 

9 XK11,XK12,XK21,XK22,XK33,XD11, 

A XNPHI.M, I , BETTA, ZETTA, XC 16 

COMMON /PLS/ OMEGA, INORD , XMERD, XPRES, XMONT 

COMMON /HOOD/ SAVYt 53) , NPLE V.NLPO, NPLA ( 2 1 ) , STR ( 6 ) , SI GMA( 3, 21 ) , 

C SEPS(3,21I«SALPH(3,21), SB APH( 3,21),STEPS(3,21) , 

0 EFF < 21 ) , STSRN (3),NPLAST(3),STSIG(3),STREPS(3), 

M STALPH(3),STBAPH(3),EFFST(3),NPLEVS(3) 

COMMON /CDISP/ P,PMAX,0ELP,DELP1,YEPS,ZEPS 
EQUIVALENCE (XNL ( 1 ) ,X1 ) , ( XNL ( 2 ) , X2 ) , ( XNL ( 3 ) , X3 ) , (K ,DELP) 

7447 GO TO ( 7341 , 7342,7343 ), IGEOM 
C THE FOLLOWING EQUATIONS ARE THE *RWAF» SET 

C EQUATIONS FOR SHELLS OF REVOLUTION ( PHI COORDINATE ) 

7341 CONTINUE 

YAOPH * XN*YPRE0(I+6)*X1R0-YPRED(I+4)*SN1R0 

YANTH = (YPRED( I+l 1 +K*XNTPH+X2*$AVY( 11 ) > * ( XC15*XC22+XD22*XK12> 

1 /( XK22*X022+XC224*2 )-K*XNTTH-X2*SAVY ( 10) + ( XK124XC22- 

1 XK22*XC 15 1* ( YPRED ( 1+3 )+K*XMTPH+X2*SAVY(l 4) I/IXC22* 

2 XC22*XK22*XD22 ) ♦{ X 1R0* (XN*YPRED( I +4 ) +YPR ED ( I +5 ) *CS- 

2 YPREDI I+6)*SN J+Xi*YA0PH*SAVY(9> )*(XKU + ( XC15*(XC15* 

3 XK22-2.0*XK12*XC22)-XK12*XK12* 

4 X022)/(XK22*XD22+XC22*XC22) ) +( X1R0SQ* ( XN*YPRED ( I+4)*SN-XNSQ 

5 4YPREDI 1+6) )+XlRO*YPRED( 1+7 )*CS >*(-XC 1 i+( XC 154XC1 5* XC22+ 

6 XC15*( XK12*XD22+XK22*XD 12 )-XK12*XD12*XC22)/( XK22*XD22+XC22*XC22 ) ) 

7 +X3*SAVY( 48 ) 

YAMTH=> ( YPREO( 1 + 3 1 +K*XMTPH+X2*SAVY( 14 ) ) *( XC 15*XC22+XK22*XD1 2) 

1 /(XK22*X022+XC22*XC22)+(YPRED(I+l)+K*XNT PH+X2*SAVY (11) 

2 )*( XD22*XC15-XD 12*XC22 ) /(XD22*XK22+ XC22**2 )— K*XMTTH— 

3 X2*SAVY( 13J+(X1R0SQ*(XN*YPRED( 1+4) *SN-XNSQ*YPRED ( 1+6 ) 1 

4 +X1R0*YPRED( 1+7 J*CS )* ( XDll- ( XD12*XD 12*XK 22+XC15* (2.0* 

5 XC22*XD12-XC 15*XD22 ) ) / I XC22*XC22+XK22*XD22 ) ) ♦( X1R0* 

6 (XN*YPRED( 1 + 4 )+YPRED( 1+5 )*C S-YPRED ( I + 6 )* SN )♦ X14YA0PH* 

7 SAVYf 9) )*(XCll+(X012*XC22*XK12-XC15*(XC15*XC22+XD12* 

8 XK22+X022*XK12) ) / ( XC22*XC22+XK22*X022 ) ) 

9 +X3+SAVY ( 49 ) 

YAMPT = ( 1.0/(XC16*SN*XiR0-XK33-SN*XlR0*(XD33*SN/( R0)-XC16))) 

1 *( (XK33*X033-XC16**2)*X1RO*(-2.0*XN*YPRED( 1+7 ) +YPRED( 1+4 )* 
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(CS*X1R1-CN1R0)+XN*YPRE0( I+5)*(XlRl+SNlR0)+2 .0*XN* YPRED 

(I+6)*CS*X1R0)+X1*SN*( YAOPH*SAVY 1 5 ) +YPRE D( I+7)*SAVY(9) 
)♦( YPRED! I l+X2*SAVY( 12) )* ( X033*SN*XIR0-XC16) +X2* 
SAVY(15)*(XK33-XC16*SN/R0)) 

♦X3*SAVY( 50 J 

YANPT = VPRED!I)+YAMPT*SN1R0 

YAJPH * YPRED! I +2 ) *X 1* ( SAVY! 8 )*YA0PH+ YANPT* SAVY! 9)-YPRED!I+i ) 

*SAVY( 5 )-YPRE0( I+7)*SAVY(6) ) 

YD 0T ( 1-4-4 ) = Rl*( YPRED! 1*4 )*CS*X1R0+X1* C YA0PH*SA VY( 5) ♦ YPRED ! 1 *7 ) * 
SAVY 19)) 

♦XN*YPRE0( I+5)*X1R0+I 1.0/1XK33- 

XC16**2/X033 ) )*!YPRED( 1 )+YAMPT*( SN*X 1RO- XC 16/XD33)+X2* 
(SAVY! 12)-XC16*SAVY( 15)/XD33>>) 

♦X3*SAVY(5l) 

YDOT! 1*5) = YPRED(I+6)-Rl*Xl+YPRED( I +7 )*SAVY l 5) +R1*( XD22*l YPRED! 1* 
1 )+K*XNTPH+X 2* SAVY l 1 1 i >+XC22* ( YPRED ( 1 *3) ♦K*XMTPH+X2* 
SAVYI 14 ) )- ! X 1R0*( XN*YPREDI I+41+YPRE0 ( 1+5 >*CS— YPRED! I ♦6 
) *SN)+X 1*YA0PH*SAVY ( 9 ) )* 

(XK 12*XD22*XC 15+XC22 )- ( X1R0SQ* ( XN* YPRED! I+4J-XNSQ* 
YPRED! 1+6) )+XlR0*YPRED! 1+7 > *CS ) * ( XC22*XD 12-XC15*XD22 > > 
/(XK22*X022+XC22**2) 

♦X3*SAVY( 52) 

A = YPRED! I +5 )*C$ 1R0-YPRED! 1*6 ) +SN1R0+S AVY!9 ) *YAOPH+ 

YDOT! 1+5) /Rl-YPRED! 1+6) /Rl+SAVY! 5>*YPRED 1 1+71 
B = SAVY! 1 ) *CS1R0-SAVY( 3 ) *SN1R0+ .5* ! SAVY! 9 )* SAVY (9 ) 

♦ SAVY! 5 »*SAVY< 5 1 »♦ t SAVY! 2)-SAVY!3) ) /R1 
YOOTII) » R1*(-2.0*YPRE0( I )*CS1R0+XN*YANTH*X1R0-XN*YAMTH*SN* 

X1R0SQ-YAHPT*CS 1R0*( X 1R1-SN1RO) )-Rl*K* (XFTHLD+XMPHLD* 
SN1R0 )— R1*X1*( SAVY (24 )*A+K*XFTHLD*B+ SAVY (25 ) *YDOT ! 1+4 ) 
/R1+SAVY(4I*K*XFPHL0/R1+SAVY!26)*YA0PH+SAVY(9)*K* 
XFZELO+SN/RO*! Y ANTH*S AVY! 9 ) +YAOPH*SAVY !7 l-YPRED ( 1+7 ) * 
SAVYI 8)-YANPT*SAVY(5) > )-X3*$AVY( 33 ) 

YDOT ( I + l ) * RI*(CS1R0*! YANTH-YPRED! I+l ) )— XN*X1R0* ( YP RED! I )♦ 

YANPT*! SN*X1R0+X1R1) ) ♦YPRED! 1+2 >*X1R1)-R1*K*XFPHLD 
-R1*X 1* (SAVY ( 25 )*A+K*XFPHLD*B 
-SAVY! 261 *YPRE0! 1+7 J- SAVY! 5 > *K*XFZELD) 

-X3+SAVY! 34) 

YDOT (1+2) = R1*(-YPRE0( I +2 )*CS1R0-YANTH*SN1R0-YPRED! I+1)*X1RI 
♦XNSQ*YANTH*X1R0SQ-2.0*XN*YAHPT*CS*X1R0SQ)+RI*K* 

( XN*XMPHLD*X 1RO-XFZELD )-Rl*Xl* ! SAVY ( 26 )* A+K*XFZELD* 
B-SAVY! 24 )*Y AOPH-SAVY ( 9) *K* 

XFTHL0+SAVY(25)*YPRED(I+7)+SAVYI5)*K*XFPHLD) 

-X3*SAVY ( 35 ) 

YDOT ( 1+3 ) = R1*(YAMTH*CS1RO-YPREO(I+3)*CS1RO-2.0*XN*YAMPT*X1RO+ 
YAJPH+K*XMTHLD) 

♦X3*SAVYI36> 

YDOT ( 1+6 ) * Rl*(YPREO(I+7)-YPRED(I+5)*XlRl) 

YDOT! 1+7 ) » R1*(XK22*(YPRE0! I +3 ) +K*XHTPH+X2* SA VY ( 14) )-XC 22*1 YPRED! 
I + l)+K*XNTPH+X2*SAVY!ll) )♦ ( X1R0* ( XN*YPRE D! I+4) + 

YPRED! 1+5) *CS-YPRED! 1+6 >*SN ) +X i*YA0PH*SA VY ( 9 ) ) * ( XK12* 
XC22-XK22*XC 15 1 

-( XlROSQ*! XN*YPRED( 1+4)* SN-XNSQ* YPRED ! I +6 1) + XIR0*YPR ED ( I +7 ) *CS )* 
(XC15*XC22+XK22*X012) )/(XC22**2+XK22*XD22) 

♦X3*S AVY C 53 ) 

GO TO 9005 

C EQUATIONS FOR CONE 
7342 CONTINUE 

YAOPH = XN*YPRED! 1+6 )*X1CS/S-YPRED! I+4)*TAN/S 

YANTH = (YPRED! I+i I +K*XNTPH+X2*SAVY (11) ) * ( XC 15*XC22+XD22*XK12) 

1 /!XK22*X022+XC22**2)-K*XNTTH-X2*SAVY(10) ♦!XK12*XC22- 

1 XK22*XC15)*(YPRED( I +3 )+K*XNTPH+X2*SAVY (14) )/(XC22* 
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XC22+XK22*XD22 ) ♦< l XN* YPRED l 1*4 >+YPREDCI+ 5 > *C S- 
YPREDl 1+6>*SN)/IS*CS)+X1*YA0PH*SAVY19>>* IXK11+ IXC15* 
(XC 15*XK22-2.0*XK 12*XC22 )-XK12*XK12* 

X022 ) / ( XK22*XD22+XC22*XC22 ) > + l l XN*YPR£D 1 1 *4 >*SN-XNS 0* 

YPREOI 1*6) )/(S*S*CSSQ)+YPRED( 1+7 > /S )*<-XCll+lXC15*XCl5*XC22+ 
XC15*( XK12*X022+XK22*X012 )-XK 12*XD12*XC22 )/(XK22*XD 22+XC22*XC22 ) ) 
+X3*SAVY 148) 

YAMTH = IYPRE01I+3)*K*XMTPH+X2*SAVY114))*IXC15*XC22+XK22*XD12) 

/IXK22*X022+XC22**2)+(YPREDU+1>+K*XNTPH+X2*SAVYC11) )* 
IXD22*XC15-X012*XC22)/IXD22*XK22+XC22**2 )-K*XMTTH-X2* 
SAV Y ( 13 ) + l 1.0/IS*S*CSSQ)* t -XNSQ* YPRED l 1+6) +XN* 

YPRED( I *4 )* 

SN)+YPREDl I+7)/SI*<XDll-lXD12*XD12*XK22+XC15*l 2.0*XC22*XD12-XC1 5* 
XD22))/lXC22*XC22+XK22*XD22))+ll.0/l S*CS )*IXN* 

YPREOI I+4)+YPRE0< 1+5 >*CS-YPREDt I+6)*SN)+X1*VA0PH* 

SAVY l 9 ) ) *1 XC 1 1+ ( X012*XC22*XK 12-XC15* t XC1 5*XC22+XD12* 
XK22+XD22*XK12) ) / l XC 22* XC22+XK22*XD22 ) ) 

♦X3*SAVYl 49 ) 

YAMPT ={ IXC16*TAN/S-XK33-(TAN/SI*(X033*TAN/S-XC16) (XK33* 
XD33-XC 16**2 )*l 1 .0/1 S*CS) )* l-2.0*XN* YPRED 11+7 )- YPRED l 1+4) * 
SN/S + XN*YPRE0U + 5)*TAN/S+2.0*XN*YPREDtI+6)/S)+Xl*SN* 
(YAOPH*SAVYl 5J+YPREDI I *7 ) *SAVYl 9 1 >♦ l YPRE D ( I) +X2* 

S AVY ( 12 ) )*( X033*TAN/ S-XC 16 ) +X2* SAVYC15)* (XK33-XC16* 
TN/SM 

+X3*SAVY150) 

YANPT = YPREOI I ) +YAMPT*TAN/S 

YAJPH = YPREDl I +2 ) + X 1*1 SAVYl 8 ) *YAOPH+YANPT*SAVYl 9)-YPRED l I + l ) * 

SAVY15J-YPREDI I+7)*SAVY16> > 

YDOT ( 1*4 J * YPRED l I +4 )/S+X 1*1 YAOPH*SAVY l 5) +YPRED ( 1+7 )*SAVY19 ) >+XN* 
YPREDl I +5 ) / l S*CS )+l 1 >0/ ( XK33-XC 16**2/ 

XD33 ) ) * (YPRED ( I )+YAMPT*( TAN/S-XC 16/XD33) +X2* l SAVY t 12 >- 
XC16*SAVY ( 15 I/XD33) ) 

+X3*SAVY (511 

YDOT ( 1*5) = -X1*YPRED< 1*7 ) *SAVY( 5 ) ♦ ( XD22* l YPRED C I* 1) +K*XNTPH+X2* 

SAVY( 11 ) )+XC22*l YPREDl J+3)+K*XMTPH+X2*SA VYI14) )- (XK12* 
XD22+XC15*XC22)*lll.0/( S*CS > * ( XN*YPRED II +4 )♦ YPREOI 1+5) 
*CS- YPRED ( 1+6)* SN) )+Xl*YA0PH*SAVYl9) )- <XC22*XD12-XC15* 
XD22)*l l-XNSQ* 

YPREDl 1+6 )+XN*YPREOC I+4)*SN ) / ( S*S*CSSG )+YPRED 1 1+7 ) /S») 

/ 1 XK22*XD22+XC 22*XC22 ) 

+X3*SAVYl 52 I 

A = YPREDl I +5 1/5 -YPREOI I +6 )*TN/S+SA VY l 9 )*YAOPH+YDOT ( 1+5 9 

+SAVYI 51* YPREDl 1+7) 

B = SAVY (11/S-SAVY13) *TN/S+0 .5*1 SAVY 1 9 ) *SAVY l 9 ) + $AVY C 5 ) * 

SAVY l 5 ) ) +5AVY l 2 ) 

YDOT 1 1 ) =-2.0*YPRE0l I ) / S+XN*YANTH*X 1C S/S-XN*YAHTH*SN*X1C$**2/S**2 

+YAMPT*TAN/S**2-K*IXFTHLD+XMPHLD*TAN/S)-Xl*l SAVY ( 24) * 
A+K*XFTHLD*B+SAVY ( 25)*YD0T l 1+4) + SAVY (4 )*K*XFPHLD+ 
SAVY(26)*YA0PH+SAVYl 9 )*K*XF ZELO + TAN/S* l Y ANTH*S AVYl 9 ) ♦ 
YA0PH*SAVYl 7J-YPREDI 1 + 7 ) *SA VY l 8 )-YANPT*SAVYl 5 ) > >-X3* 
SAVY133) 

YDOT l 1+11= -YPREDl 1+11/ S+YANTH/S-XN*YPREDl I) / < S*CS )- XN*Y AMPT*SN/ 
l S*S*CS*CS ) -K*XFPHLD-Xl* l SAVY 125 )*A+K*XF PHLD*B- 
SAVY<26)*YPREDl 1+7 )-SAVY l 5 ) *K*XFZELD > 

-X3*SAVYl 34) 

YDOT 11+2) = -YPRED (1 + 2 ) /S-YANTH*T AN/ S+ XNSQ* YAMTH / ( S* *2*CS**2 ) 

-2.0*XN*Y AMPT/IS**2*CS >+K*< XN*XMPHLD*X 1C S/S-XFZELD) 

+X 1*1 SAVY ( 26 )*A+K*XFZELD*B-SAVYl 24)*YA0PH-SAVYI9)*X* 
XFTHUD+SAVY l 25 > *YPRED l l +7 )+ SAVY l 5 ) *K*XFPHLD) 

— X3*S AVYl 35 ) 

YDOT l 1+3 )= Y AMT H/S- YPREOI I +3 ) /S-2. 0*XN*YAMP T/ ( S*CS )+ YA JPH+XHTHLD 
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1 *K 

2 +X3*SAVY I 36 ) 

YOOT I 1+6 )=YPREDI 1*7 ) 

YDOTII+7) = (XK22*IYPREDI I+3)+K*XMTPH+X2*SAVY(lA) )-XC22* 

(YPREDI I + 1)+K*XNTPH+X2*SAVY(U) ) ♦ I XK12*XC22-XK22*XC1 5 > 
*< I 1.0/(S*CS)*(XN*YPREDI I+Al+YPREDI 1+5 )*CS-YPRED ( 1+6 >* 
SNI ) +X1*YA0PH*SAVY( 9 ) )-< XC 1 5*XC22+XK22*XD12 ) * 

( I-XNSQ*YPRED( I+6)+XN*YPRED( I+A)*SN)/(S*S*CSSQ)+ 
YPRED(I+7)/S) )/(XK22*XD22+XC22*XC22) 

♦X3*S AVY 153) 

GO TO 9005 

EQUATIONS FOR CYLINDER 


YAOPH = X1R0*(XN*YPRED( I+6)-YPRED( 1*4) ) 

YANTH = (YPREDI I+l )+K*XNTPH+X2*SAVYI 11 ) > * I XC15*XC22+XD22*XK12) 

/(XK22*X022+XC22**2)-K*XNTTH-X2*SAVY(10) +(XK12*XC22- 
XK22*XC 15 )*IYPRED(I+3) +K*XMTPH+X2*SAVY(l A ) ) / I XC22* 
XC22+XK22*XD22)+(X1R0*(XN*YPRED( I+A >-YPR ED ( I +6 > ) + X1* 
YAOPH*SAVY 1 9 )) *t XK ll + l XC 15* I XC15*XK22-2. 0*XK12*XC22 ) - 
XK1 2*XK 12* 

XD22 ) / ( XK22*XD22+XC22*XC22 ) ) + ( X 1R0SQ* ( XN*YPRED ( I+A) -XNSQ 
*YPRED< 1+6) ) )*I-XCll+(XC15*XC15*XC22+ 

XC15*IXK12*XD22+XK22*XD12)-XK12*XD12*XC22)/IXK22*XD22+XC22*XC22) ) 
+X3*SAVY(A8) 

YAMTH = (YPREDI 1+3 ) +K*XHTPH+X2*SAVY I 1A ) ) * I XC15*XC22+XK22*XD 12 ) 

/(XK22*X022+XC22**2)+< YPREOt I + l ) +K*XNTPH + X2*SAVY 1 11 » )* 
I X022*XC 15-X0 12*XC22 )7( X022*XK.22+XC22**2 )-K*XMTTH-X2* 
SAVYI 13 J + X1ROSQ* I XN* YPREDI I +A)-XNSQ*YPRE DI 1+6) ) 
*(X011-(XD12*X012*XK22+XC15*(2.0*XC22*XD12-XC15* 

XD22) )/(XC22*XC22+XK22*X022) )+ I X1R0*IXN* YPREDI I+A )- 
YPRED( I+6))+Xl*YAQPH*SAVY(9))*IXCll+IXD12*XC22*XK12- 
XC15*1XC15*XC22+XD12*XK22+ 

X022*XK 12 ) ) / ( XC22*XC22+XK22*X022 ) ) 

+X3*SAVYIA9I 

YAHPT=I 1/<XC16*XIR0-XK33-X1R0*IX033*X1R0-XC16) ) )* I IXK33*XD33-XC16 
**2 ) *X 1R0*I -2. 0*XN*YPRE0I 1+7 )+XN*XlRO* YPREDI 1+5) )+Xl* 

( Y AOPH* SAVY I 5 ) + YPRED I I +7 )* SA VY 1 9 ) ) ♦ I YPRE D 1 1 ) +X2* 

SAVY 1 12 ) ) * I XD33*X1R0— XC 16)+' < 2*SAVYI 15)*I XK33-XC16/RO) ) 
+X3*SAVY l 50 ) 

YANPT = YPREDI I I+YAMPT*X1R0 

YAJPH = YPRED(I+2)+Xl*(SAVYI8)*YA0PH+YANPT*SAVYI9)-YPREDII+l) 

*SAVY(5I -YPREDI I+7)*SAVY(6) ) 

YOOT I I+A ) = X1*IYA0PH*SAVY( 5I+YPRED1 1+7 ) *SA VY (9 ) ) +XN+YPRED I I +5 > /RO 


(1.0/IXK33-XC16**2/XD33) )*I YPREDI I )♦ 
YAMPT*IX1R0-XC16/XD33)+X2*( SAVYI 12 ) -XC 16*SAVYI 15 ) f 
X033 ) ) 

♦X3*SAVY I 51 ) 

YOOT I 1 + 5) = -X1*YPRE0( 1+7 )*SAVYI 5 ) ♦ I XD22* I YPRED 1 1+ 1) +K*XNTPH + X2* 

1 SAVYI 11) )+XC22*(YPREDl I +3 ) +K*XNTPH+X2*SA VY I 1 A) )-IXlRO* 

1 IXN*YPREDII+A)- YPREDI I + 6 )) + X1*Y AOPH*SAVY 1 9 ) ) *( XK12* 

2 X022+XC15*XC22)-X1R0SQ*(XN*YPRED 

21 I +A)-XNSQ*YPRED( 1 + 6) )*( XC22*X012-XC 15*XD22 )) / 1 XK22*XD22+XC2 2**2 ) 

3 +X3*SAVY I 52 ) 

A * -YPREDI 1+6 ) /RO+SAVYI 9 ) *YAOPH+YDOT II+5)+SAVY(5)* 

1 YPREDI 1+7) 

B = -SAVY(3)/R0+0.5*(SAVYI9)*SAVY(9)+SAVY(5) *SAVY(5) )♦ 

1 SAVYI 2) 

YDOTII) = XN*YANTH*X1R0-XN*YAMTH*X1R0SQ-K* I XFTHLD+ XMPHLD*X1R0) 

1 -X1*(SAVYI2A)*A+K*XFTHL0*B+SAVY(25)*YD0T I I+A )+SAVY(A»* 

2 K*XFPHLO+SAVY I 26 ) *YAOPH+SAVY 1 9 ) *K*XFZELD+ I YANTH* 
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3 SAVY(9)+YA0PH*SAVY(7)-YPRED{I+7)*SAVY(8)-YANPT* 

4 SAVY < 5 ) ) /RO ) -X3*SAVY ( 33 ) 

YDOTd + 1) = -XN*X1R0*YPRED< I )-XN*YAMPT*XlROSQ-K*XFPHLO-Xl* 

1 ( SAVY J 25 ) *A+K*XFPHLD*B-SAVY I 26) *YPRED( 1+ 7) -SAVYI 5 ) * 

2 K*XFZELD) 

3 -X3*SAVY<34) 

YDOTII+2) = -YANTH*X1R0+XNSQ*YAMTH*X1R0SQ+K*(XN*XHPHLD*X1R0- 

1 XFZELO)-Xl*( SAVY ( 26 ) *A+K*XFZELD*B— SAW (24) 4YAOPH- 

2 SAVY < 9) *K*XFTHLD+SAVY (25)*YPRED(I+7)+SAVYI5) *K*XFPHLD) 

3 -X3*SAVYl 35 ) 

YOOT 11+3) = -2.0*XN*YAHPT*X1R0+YAJPH+K*XMTHLD 
1 +X3*SAVY(36) 

YOOT ( 1*6 )=YPRED( 1+7 ) 

YDOT ( 1+7 ) = (XK22*(YPRED( 1+3 ) +K*XMTPH+X2*SAVY (14))-XC22* 

1 < YPREDt I+1)+K*XNTPH+X2*SAVY( 11) )+(XlRO*( XN4YPRED ( 1+4 )- 

1 YPRED( 1+6) )+Xl*YA0PH*SAVY<9) ) * ( XK12*XC22 -XK22*XC15 )- 

2 XlROSQ*(XN*YPREO 

2 ( I +4 ) -XNSQ*YPRED( 1+6) )* ( XC15*XC22+XK22*XD12 ) ) / < XC22**2+XK22*X022 ) 

3 +X3*SAVY( 53) 


9005 CONTINUE 
RETURN 
END 


602420 

602430 

602440 

602450 

602460 

602470 

602480 

602490 

602500 

602510 

602520 

602530 

602540 

602550 

602560 

602570 

602580 

602590 

602600 

602610 

602620 

602630 
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SUBROUTINE SEGMAT 


The results of the subroutine link, RIEMAN, are passed through the label 
common area, LZCORR, to this subroutine. SEGMAT places the elements of 
the YCORR array into several double-subscripted arrays, forms some 
coordinate transformation arrays, and calls subroutine SREVN2 for double 
precision matrix inversion. 

As a result of appropriate matrix operations this subroutine produces a 
segment stiffness matrix, the XKS array, and a segment load matrix, the 
XLS array, for each segment. SEGMAT also orients each segment into the 
global corrdinate system of the structure as a result of the matrix 
operations. 

Subroutine SREVN2 

SREVN2 is a subroutine called by SEGMAT to invert a real, double-precision, 
in-core matrix utilizing Gauss-Jordan elimination with partial pivoting. 



FORTRAN CODE 


ENGINEERING SYMBOLS (REF. 1 ) 


SNI 

SNJ 

CSI 

CSJ 


si 

sj 

ci 

cj 


A MATRIX 


B MATRIX 


C MATRIX 


D MATRIX 


E MATRIX 


XKT MATRIX 
XMAX MATRIX 

XKS MATRIX 
XLS MATRIX 


’ I FT 



0 

JFT 

- 

0 

I, 

r 

0 

_ T l" 

X 

ro 1 

1 


’_V 

0 

! o 

0 

'}Z 

j 0 
1 

0 

0 

V\ 




T h 

0 

| 0 

-r 

T 

JDT 

i- y 3 


0 

T~v 

idt t 

0 

! 0 

■o"; 

I 

1 

| -=r 

i M 

1 

! ° 
i 

. ° "i 

0 



r- r o4)j- 
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SEGMAT 


FORM 


CALL 

SREVN2 


FORM 


FORM 
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FOR, IS SEGMAT , SEGMAT 

SUBROUTINE SEGMAT 

INTEGER SAVJTC, SAV$TP*Q» THICK 

INTEGER XN 1 » XN 

OOUBLE PRECISION CC , ALA8EL 

COMMON STORY ( 16 ) , XM AT ( 270,10 ) , STD( 10 ) * SADUSI 30 1 ,RADUS( 30 I 
COMMON T AOUS ( 30 ) , UAOUS ( 30 ) , SAVT IC 1 9001 

COMMON XN.TEFREE, T IC, PHI , STOP ,RE STOP ,RTICK ,GI , XNL ( 3) ,NH 

COMMON NST(30)«NKL(30 ) ,NXMAT ( 20) , SAVJTC ( 30 ) » S A VS TP (30),JRTIC(30) 

COMMON JRSTOPI 30 ) » NREG, NMPT«NRC» NSC * NIX * IERROR « KGEOM , IGEOM.I STTAB 

COMMON KELVIN, IBEGIN, NPR08,NSEG,NERR0R,Q, THICK, NOJS, NLINKS,NLCASE 

COMMON NTSKL ,NZ«NBCT«L INPUT ,NTRKL , NPASS , XNI ,KBC tNRINGS 

COMMON LOOE, ICYCLE, LOISTL 

COMMON /LYCORR/ YC0RRI72) 

DIMENSION C(9,9),CC(*,*),0(9,9>,E(9,9),B(8,9),A(8,8> 

DIMENSION Xl(9«9),X2(9,9)fX3!8,9) ,XKT( 8,91, XMAX ( 8, 91 
DIMENSION XKS(8,9),XLS(8,1),SYM(8,9> 

DIMENSION DEAD(4) 

DIMENSION ALABELI8) 

EQUIVALENCE IC(l) , EllI , X3I1I ,XMAX(1I ,XLS* 1 II 

EQUIVALENCE (X2( l > , D( l > , A ( 1 > , XKS (1) > , I XI (1) ,8 (1) ,XKT (1) , SYM( 1 > ) 
DATA ALABEL/8HF0RCE T1,8HF0RCE Z 1.8HF0RCE R 1 , 8HM0MEN T 1, 

1 8HF0RCE T2, 8HF0RCE Z2,8HFORCE R2,8HM0MENT 2/ 

IF (NH.EQ.O) MR I TE( 6, 1726 ) 

1726 FORMAT ( 1H1 ) 

A1=G1 

GOTO (601,602,603), 1GE0M 

601 SNI = SIN(TIC) 

SNJ * SI N( STOP ) 

CSI = COS ( TIC) 

CSJ * COS( STOP) 

GOTO 1 

602 SNI = C0S1 1 . 570796-Al ) 

CSI * SIN( 1. 570796-All 
IF (Al.NE.O.O) GO TO 60* 

SNI = 0.0 

CSI = 1.0 
60* SNJ = SNI 
CSJ = CSI 
GOTO 1 

603 SNI = 1.0 
SNJ =1.0 
CSI = 0.0 
CSJ = 0.0 

l JJ = 8*NPR0B 
DO 111 J=1,JJ 
DO 111 1=1, JJ 

111 C(I,J)=0.0 
K s 28 

DO 112 J*1,A 

K=K+8 

L=K 

DO 112 1=1,* 

L=L+1 

112 CC ( I , J )=YCORR(L 1 

CALL SREVN2 (CC, *, DEAD,* ,N I X ) 

IF (NIX.NE.0 ) GOTO 8120 
J1=0 

DO 113 J=5»8 
J1=J1+1 


800010 

800020 

800030 

8000*0 

800050 

800060 

800070 

800080 

800090 

800100 

800110 

800120 

800130 

8001*0 

800150 

800160 

800170 

800180 

800190 

800200 

800210 

800220 

800230 

8002*0 

800250 

800260 

800270 

800280 

800290 

800300 

800310 

800320 

800330 

8003*0 

800350 

800360 

800370 

800380 

800390 

800*00 

800*10 

800*20 

800*30 

800**0 

800*50 

800*60 

800*70 

800*80 

800*90 

800500 

800510 

800520 

800530 

8005*0 

800550 

800560 

800570 

800580 

800590 
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11=0 

800600 


00 113 1=5,8 

800610 


U-U*\ 

800620 

113 

Ct l,J)=CCt II,J1> 

800630 


DO 114 l J=1 , 4 

800640 

114 

CC IJ, IJ)=1.0 

800650 


DO 115 I J=9, JJ 

800660 

115 

CC IJ,IJI=l.O 

800670 


DO 116 J=1,JJ 

800680 


DO 116 1=1, JJ 

800690 

116 

DCI,J)=0.0 

800700 


DO 117 I J=l,4 

800710 

117 

D< IJ,IJ) = 1.0 

800720 


1 = 5 

800730 


o < i,n=i.o 

800740 


oi i+i, i-m—SNj 

800750 


DC 1+2, I*2)=-SNJ 

800760 


D ( 1+3, 1*3 ) =1 .0 

800770 


DC 1*1, 1*2 1* CSJ 

800780 


DC 1+2, I + H—CSJ 

800790 


00 218 I J=9, JJ 

800800 

218 

DCIJ,IJ)=1.0 

800810 


K=-4 

800820 


DO 118 J=l,4 

800830 


K=K*8 

800840 


L=K 

800850 


DO 118 1=5,8 

800860 


L=L+l 

800870 

118 

DCI,Jl= -YCORRCL) 

800880 


K=60 

800890 


DO 119 J=9« JJ 

800900 


K=K*8 

800910 


L=K 

800920 


DO 119 1=5,8 

800930 


L=L*l 

800940 

119 

DC I, J l=-YCORRCL 1 

800950 


DO 120 J=1,JJ 

800960 


DO 120 1=1, JJ 

800970 


X1(I,J)=0.0 

800980 


DO 120 M=1,JJ 

800990 

120 

XI (I,J)=X1C I,J)+C1I,HI«DCM,J) 

801000 


DO 121 J=1,JJ 

801010 


00 121 I=1,JJ 

801020 

121 

EC I,J)=0.0 

801030 


1=1 

801040 


ECI,I>=1.0 

801050 


EC1+1, I*l»=-SNI 

801060 


E C 1+2, 1+2 >=-SNI 

801070 


EC 1+3, I+31 = 1.0 

801080 


EC I+l» I*2I=CSI 

801090 


EC 1+2. I + D—CSI 

801100 


DO 122 J=5, JJ 

801110 

122 

EC J, J»=1.0 

801120 


DO 123 J=1,JJ 

801130 


DO 123 I=1,JJ 

801140 


X2 ( 1 , J ) = 0 .0 

801150 


DO 123 M*l, JJ 

801160 

123 

X2(I,J)=X2(I,J)*X1C I,N)*EIM, J) 

801170 


DO 124 J=1,JJ 

801180 


DO 124 1=1,8 

801190 

124 

BC 1,J)=0.0 

801200 


«7 



J=4 

DO 125 1*1, 4 

J = J + l 

125 B< I, J) * 1.0 
K = -8 

00 126 J=l,4 
K = K+8 
L = K 

00 126 1=5,8 
L=L+1 

126 B l I , J ) =YC0RR ( L ) 

K = 24 

DO 127 J=5»8 

K=K+8 

L=K 

DO 127 1=5,8 
L=L+i 

127 B(I,JI=YCORR(U 
K=56 

DO 128 J=9* J J 

K=K+8 

L=K 

DO 128 1=5,8 
L=L+i 

128 B( I»J)=YCORRCL> 

DO 129 J=1,JJ 
DO 129 1=1,8 

X3 ( I , J )=0.0 
DO 129 M=l» JJ 

129 X3(I,J>=X3C I,J)+BCI,M)*X2CM,J> 

DO 130 J=1 *8 

DO 130 1=1,8 

130 AC I , J )=0 .0 
1=1 

Al I, I )=-1.0 
AC I+l, I + l )=SNI 
AC 1+2, I + 2 > = SNI 
AC 1*1, I+2)=CSI 
AC 1*2, I + l )=-CSI 
AC 1+3, 1 + 3 ) = l .0 

1 = 5 

AC I,I) = 1.0 
AC I+lt I + U=-SNJ 
AC l+2,I+2»=-SNJ 
AC 1+3, I +3 )=-l .0 
AC 1+1, 1 + 2 )=-CSJ 
AC 1+2, 1 + 1 )=CSJ 
DO 131 J=1,JJ 
DO 131 1=1,8 
XKT ( I , J I =0.0 
DO 131 M=l,8 

131 XKTCI,J)=XKTC I.JI+AC I,M)*X3CM,J) 
PI=3. 1415927 

RI*RTICK 

X2PIRI=2.0*PI*RI 
RJ=RESTOP 
X2PIRJ=2.0*PI*RJ 
DO 132 J=l,8 
DO 132 1=1,8 

132 XHAX 1 1 , J ) = 0 . 0 
00 133 1=1,4 


801210 

801220 


801290 
801300 
801310 
801320 
801330 
801340 
801350 
801360 
801370 
801380 
801390 
801400 
801410 
801420 
801430 
801440 
801450 
801460 
801470 
801480 
8014^0 
801500 
801510 
801520 
801530 
801540 
801550 
801560 
801570 
801580 
801590 
801600 
801610 
801620 
801630 
801640 
801650 
80 1660 
801670 
801680 
801690 
801700 
801710 
801720 
801730 
801740 
801750 
801760 
801770 
801780 
801790 
801800 
801810 
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133 XMAX!I,ll=X2PIRI 
DO 134 J = 5,8 

134 XMAX< J,J1=X2PIRJ 
DO 135 J=1,JJ 
DO 135 1 = 1,8 
XKS(I,J)=0.0 

00 135 M=1 » 8 

135 XKS!I,J}=XKSII,JI+XMAXI I ,M l*XKT!M, J I 
WRITE (9) IIXKTI I , J I , J = 1 , 8 ) , 1 = 1 ,4 ) , IGE0M,G1 
WRITE (9 1 ( IXKTI I,JI,J=9, JJ),I=l,4l 

IF ( NH. NE .0 .AND.IBEGIN.NE.il GO TO 25 
WR ITE C 6,781) 

781 FORMATI//55X.22HSTIFFNESS COEFF IC IENTS//14X, 8HDELTA T1.7X, 

1 8HDELT A Z1 , 7X, 8HDELTA R 1, 7X, 7HTHE TA 1, 8X.8HDELTA T2 ,7X, 8HDELTA 22 

2 , 7X » 8HDELT A R2« 7X* 7HTHETA 2) 

II 1=0 

DO 20 M=l,8 

WR ITEI6# 23 ) ALABEL(M),(XKSIM,J),J=1,8I 
23 FORMAT! /IX, A8, IX, 8<E14. 7,1X11 
20 CONTINUE 

9968 FORMAT ( 1H , 8 ( E14 .7, 2X )/ I 5X, 8( E 14. 7, 2X II > 

25 CONTINUE 
Jl=8 
ISEG=0 
NRC1=NRC- 1 

IFINRC1.EQ.01G0T0 143 
DO 244 I=1,NRC1 
244 ISEG= ISEG+NST ( I ) 

143 ISEG= ISEG+NSC 

S AVT I Cl ISEGI =T IC 

WRITE! 2 > HXKS! I, JI,J = 1, 01,1 = 1,8) 

DO 137 J=l,8 
DO 137 1=1,8 

137 SYMI I , J 1=0 .0 
INDEC=0 

00 138 1=1,8 
DO 138 J=1 , 8 
IFIJ.NE.I J GO TO 138 
IF!XKS!I,J) . GE.O .0 IGO TO 138 
IN0EC=1 

138 SYM! I , J >=XKS< I , J ) 

IF I INDEC .EQ.O IGO TO 151 
WRITE (6, 152 ) 

152 FORMAT !////• ********************************** WARNING - NEGATI 
IVES APPEAR ON MAIN DIAGONAL. REVISE SIZING *************♦«.*•//) 
151 JJ=2 
N = 8 
J = 1 

DO 42 11=1,7 

N = JJ 
DO 43 I=M,N 

ALPH = ABS ( SYM! I , J ) I - ABS!SYMI J, I ) ) 

IF1ALPH) 47,71,48 

47 IF(SYMII,J).EQ.O.O) GOTO 71 

SYMII.JI = SYM! J , I ) / SYM1I.JI • 

GOTO 43 

48 IF!SYM!J,I).EQ.0.0) GOTO 71 
SYM! I , J) = SYMII.JI / SYM ( J , I I 
GOTO 43 

71 SYMII.JI = 1.0 
43 SYMij.II = 0.0 


801820 
801830 
801840 
801850 
801860 
801870 
801880 
801890 
801900 
80191G 
801920 
801930 
801940 
801950 
80 1960 
801970 
801980 
801990 
.802000 
802010 
802020 
802030 
802040 
802050 
802060 
802070 
802080 
802090 
802100 
802110 
802120 
802130 
802140 
802150 
802160 
802170 
802180 
802190 
802200 
802210 
802220 
802230 
802240 
802250 
802260 
802270 
802280 
802290 
802300 
802310 
802320 
802330 
802340 
802350 
802360 
802370 
802380 
802390 
802400 
802410 
802420 


69 



JJ = JJ *1 802*30 

J = J+l 802**0 

*2 CONTINUE 802*50 

IF ( NH.NE.O . AND. IBEGIN.NE.I) GO TO 1*5 802*60 

WRITE (6,785 ) 802*70 

785 FORMAT ( //55X , 22HSEGHENT SYMMETRY CHECK.) 802*80 

DO 1** 1=1,8 802*90 

1** WRITEC6.9968) ( SYM 1 1 , J ) , J= l , 8 ) 802500 

1*5 IF ( NPROB . EQ .0 ) GO TO 9999 802510 

DO 136 J=l, NPROB 802520 

J1=J1+1 802530 

DO 136 1=1,8 8025*0 

136 XLS ( I , J ) =XKS < I , J 1 ) 802550< 

WRITEI3) ( ( XLS ( I , J ) » J=l, NPROB ),I=1,8) 802560 

IF (NH.NE.O. AND. IBEGIN.NE.I) GO TO 9999 802570 

WRITE (6,782) 802580 

782 FORMAT (//55X, 22 HSEGMENT LOAD MATRICES ,) 802590 

DO 8*0 1=1,8 802600 

8*0 WRITE(6»9968)(XLS(I»J),J=1» NPROB) 802610 

GOTO 9999 802620 

8120 IERR0R=8120 802630 

NERROR=29 8026*0 

8888 NIX=1 802650 

9999 CONTINUE 802660 

IF (NH.EQ.O.OR. IBEGIN.EQ . 1 ) WRITE(6,795) RTICK, RESTOP 802670 

795 FORMAT ( /.' RZERO(I) =• , 1PE15.6, 10X , 'RZEROI J) =‘,1PE15.6) 802680 

RETURN 802690 

END 802700 



FOR, IS SREVN2.SREVN2 



SUBROUTINE S REVN2 t A, M, LOC, M ID , N I X ) 

900010 


DOUBLE PRECISION A(MI0»1I,P I VO T, TEMPI 

900020 


integer Locm 

900030 

100 

N = M 

900040 


DO 190 K = l.N 

900050 


PIVOT = O.DO 

900060 


DO 120 I = K,N 

900070 


IF (PIVOT - DABS (A( T.k))) 110,110,120 

900080 

110 

PIVOT = DABS ( A ( I , K ) ) 

900090 


L = I 

900100 

120 

CONTINUE 

900110 


IF (PIVOT) 140,130,140 

900120 

130 

NIX = -1 

900130 


GO TO 210 

900140 

140 

LOC(K) * L 

900150 


DO 150 J = l.N 

900160 


TEMPI = A ( K , J ) 

900170 


A ( K, J ) * A ( L , J ) 

9001B0 

150 

A ( L , J ) = TEMPI 

900190 


TEMPI = AIK, K ) 

900200 


A(K,K) = 1.00 

900210 


DO 160 J = l.N 

900220 

160 

A ( K, J ) = A ( K , J ) /TEMP 1 

900230 


DO 190 I - l.N 

900240 


IF (I - K) 170,190,170 

900250 

170 

TEMPI = -A( I, K ) 

900260 


A ( I , K ) = O.DO 

900270 


DO 180 J = l.N 

900280 

180 

A ( I , J ) = A ( I , J ) ♦ TEMP1*A(K» J ) 

900290 

190 

CONTINUE 

900300 


DO 200 K = l.N 

900310 


NK = N - K 

900320 


L = LOCtNK+l) 

900330 


DO 200 I * l.N 

900340 


TEMPI = A( I , NK+1 I 

900350 


A ( I ,NK* 1 ) = A ( I , L ) 

900360 

2UU" Ad.U = TEMPI 

900370 


NIX = 0 

900380 

210 

RETURN 

900390 


END 

900400 
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SUBROUTINE REGMAT 


The segment stiffness matrices, XKS, and the segment load matrices, XLS, 
are passed from SEGMAT to REGMAT via Tapes $2 and #3, and are placed in 
the XKRTOT array and the XLRTOT array, respectively. If kinematic links 
occur between segments in the region, the XKRTOT array and the XLRTOT 
array are modified to represent the situation. In the case of discrete 
rings the routine RINGER is called and provides the necessary matrices. 

A horizontal and vertical partitioning of the XKRTOT array occurs while 
the XLRTOT array is subjected to a horizontal partitioning only. 

Appropriate matrix operations are performed upon the partitions of each 
array, thus reducing the size of the region stiffness and load matrices 
and resulting in increased program capacity. The results of these mani- 
pulations are the region stiffness matrix, XKR, and the region load 
matrix, XLR. 

Subroutines Called from REGMAT 

Subroutine SYMSOC ; Is the controlling routine for the solution of sparse, 
band-like, positive-definite, symmetric coefficient matrices. 

Subroutine BANDIT : Is a routine called from SYMSOC which compacts a matrix 

into the special vector form required. 

Subroutine LLTRAN : Is a routine called by SYMSOC for Cholesky factorization 

of sparse, band-like coefficient matrices. 

Subroutine HOTPOT : (Alternate entry points PREFCE and FOREWD. ) Is a small 

subroutine used repeatedly for efficiency in computing inner products. 

Subroutine TRISLV : (Alternate entry point TRISOL. ) Is a routine called 

by SYMSOC to carry out the solutions of sparse, bank-like, triangular 
coefficient matrices. 
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FORTRAN CODE 
SKL MATRIX 

SKLTR MATRIX 
XKRTOT MATRIX 


XLRTOT MATRIX 


ENGINEERING SYMBOLS (REF. 1 


[skl] 

JsklJ t 



L' 


) 


SKL22 MATRIX 


REGTOT MATRIX 


STORE MATRIX 


XK11 PARTITION 


XK12 PARTITION 


XK22 PARTITION 


XK21 PARTITION 
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FORTRAN CODE 


XL1 PARTITION 


ENGINEERING SYMBOLS (REF. 1 



) 


XL2 PARTITION 
XKR MATRIX 


A 



XLR MATRIX 
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ENTRY 


REGMAT 
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FOR. IS REGMAT, REGMAT 

SUBROUTINE REGMAT 1000010 

INTEGER SAVJTC.SAVSTP.Q, THICK 1000020 

INTEGER XN1.XN 1000030 

OOUBLE PRECISION ALABEL - 1000040 

COMMON STORY (16)«XMAT(270,10),STD(10), SAOUS (301 .RADUS(30> 1000050 

COMMON T AOUS (30 )»UAOUS(30)*SAVTIC(900) 1000060 

COMMON XN, TEFREE, TIC, PHI, STOP, RESTOP, RTICK, Gl, XNU3) ,NH 1000070 

COMMON NST(30),NKL( 30 ) *NXMAT( 20) » SAVJTC ! 30) , SAVSTP(30) .JRTICC30) 1000080 
COMMON JRST0P(30),NREG,NMPT,NRC,NSC,NIX,IERR0R,KGE0M,IGE0M,ISTTAB 1000090 
COMMON KELVIN, I BEGI N, NPROB, NS EG,NERR0R , Q.THICK, NOJS, NLINKS, NLCASE 1000100 
COMMON NTSKL,NZ,NBCT,LINPUT,NTRKL,NPASS,XN1,KBC,NRINGS 1000110 

COMMON LODE, ICYCLE.LOISTL 1000120 

COMMON /0PT2/ PRINT 1000130 

COMMON /ARING/ NRINGC 28 ) , AMATI 30, 8 > ,RS IG< 12 1 ,REPSI 12 I , RALPH ( 12 > , 1000140 

C R8APHI12) 1000150 

COMMON /PLSTIC/ 10, JO, IOR, JOR.KORI , NEO 1000160 

DIMENSION OPEN( 4,4) 1000170 

DIMENSION XTEMPI 8,8),SKL(120,120),SKLTR(120) 1000180 

DIMENSION SYM( 8 ,8) 1000190 

DIMENSION XKRTOT(120*120),RTEMP(120),XLRTOT(120,2),XKEEP(8,2) 1000200 

DIMENSION STORE! 120, 2), ROW! 120 ) .REGTOT ( 120 1 ,H0LD(4,120> 1000210 

DIMENSION XK22I 112, 112 ) , XK1 II 8, 8 > , XK12 1 8, 112 ) ,XK21 (1 12,8) 1000220 

DIMENSION XK1221(8,8),XKR(8,8) , LEAD( 8) 1000230 

DIMENSION XL 1(8,1), XL 2(112,1), XK12L2(6,1),XLR (8,1) 1000240 

DIMENSION JOEPI 112>,J1N0(15),ANGLE(15) 1000250 

DIMENSION RNGT0T(4,4 ) .RNGLODI 4,28 ) , JTNO ( 28 ) 1000260 

DIMENSION ALABELI 8) 1000270 

EQUIVALENCE ( SYM( 1 ) .XK12L2 ( 1 1 .XK1221 Cl) ,HOLD( 1 ) , JDEP ( 1 ) ) 1000280 

EQUIVALENCE (SKL( 1 1 ,XKRTOT( 1 ) , XK22 ( 1 ) .XLRTOT (1) ) 1000290 

EQUIVALENCE (XKR( 1 ) ,XKl 1 ( 1 ) .XTEMPI l ) ,XLR ( 1 ) , XL 1 1 1 ) ,XKEEP ( 1 ) , 1000300 

1 RT EMP ( 1 ) , ROW ( 1 ) ) 1000310 

EQUIVALENCE ( SKLTRI 1 ) , REGTOT ( 1 ) «OPEN( 1 ) , XK12 ( 1 ) ) 1000320 

EQUIVALENCE (STORE! ll,XL2( 1 ) , XK21 ( 1) ) 1000330 

DATA ALABEL/8HF0RCE Tl, 8HF0RCE Z1.8HF0RCE R1 , 8HM0MEN T 1, 1000340 

1 8HF0RCE T2, 8HF0RCE Z2.8HF0RCE R2.8HM0MENT 2/ 1000350 

REWIND 2 1000360 

REWIND 3 1000370 

D * 0.0 1000380 

PRINT = 0.0 1000390 

NOJ * NST(NRC) ♦ NKL(NRC) +1 1000400 

N0J4 = N0J*4 1000410 

NSKL = NKL(NRC) 1000420 

NH4=4 1000430 

NJTNH4=NH4*N0J 1000440 

NJINK4 = ( NOJ-NSKL ) *4 1000450 

M8*NJINK4-8 1000460 

NKIV = NJ INK 4 - 8 1000470 

IF (NST(NRC) .EQ.l) GOTO 1 1000480 

REWIND JO 1000490 

IF (NH.NEkO. AND. IBEGIN.NE. 1 ) GO TO 690 1000500 

WRITE (6, 1726) 1000510 

1726 FORMAT! 1H1 ) 1000520 

WRITEI6.681) NRC, NOJ, NSKL 1000530 

681 FORMAT ( ////5 1X3 1H INPUT DATA FOR SEGMENT C0UPLING///2 5X 14HREGI0N NU 1000540 

1MBER ,12,5X2 5H NUMBER OF SEGMENT JOINTS , 13 , 5X, 26HNUMBER OF KINEMAT 1000550 
2 IC LINKS ,13//) 1000560 

WRITEI6.682) 1000570 

682 FORMAT (41X.7HSEGMENT ,11X,8HJ0INT( I ) , 11X , 8HJ0 TNT ( J) // ) 1000580 

DO 683 I = 1 , NSEG 1000590 
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KT 1C = SAVJTCII) 

1000600 


KSTOP* SAVSTPII) 

1000610 


WR ITE l 6 , 684 ) I.KTIC.KSTOP 

1000620 

684 

FORMAT 143X.2 113, 16XI.I3) 

1000630 

683 

CONTINUE 

1000640 

690 

CONTINUE 

10006S0 


NNT => NST (NRC) 

1000660 


DO 350 I=1»N0J4 

1000670 


00 350 J=1,N0J4 

1000680 

350 

XKRTOT l I , J )=0.0 

1000690 

591 

FORMAT 1315, 16A4) 

1000700 


DO 701 N'S* 1, NNT 

1000710 


READ! 2 ) ( l XTEMPl I,J),J*l,8),I*l,8) 

1000720 


J1 = SAVJTCCNS) 

1000730 


J2 = SAVSTPINS) 

1000740 


ri = 4*01-1 ) 

1000750 


L = II 

1000760 


IF (J1.GT.J2) GOTO 950 

1000770 


00 910 I * 1,8 

1000780 


JJ * L 

1000790 


II = II + 1 

1000800 


DO 910 J = 1,8 

1000810 


JJ = JJ ♦ 1 

1000820 

910 

XKRTOT ( I I, J J ) =XKRTOT t 1 1 * JJ )+XTEHP ( I , J) 

1000830 


GOTO 701 

1000840 

950 

JJ »' 4*02-11 + 1 

1000850 


II = II + 1 

1000860 


DO 960 JK * 1,4 

1000870 


GOTO 1951,952,953,954) , JK 

1000880 

951 

IX = II 

1000890 


IND * II 

1000900 


DO 961 1=1,4 

1000910 


DO 961 J* 1 ,4 

1000920 

961 

OPEN(I.J) = XTEMPl I , J ) 

1000930 


GOTO 955 

1000940 

952 

IX * II 

1000950 


IND = JJ 

1000960 


DO 962 1*1,4 

1000970 


DO 962 J=l,4 

1000980 

962 

OPEN! I , J ) = XTEMPl I, J+4) 

1000990 


GOTO 955 

1001000 

953 

IX = JJ 

1001010 


IND * II 

1001020 


DO 963 1*1,4 

1001030 


DO 963 J=l,4 

1001040 

963 

OPEN! I , J ) = XTEMPl 1+4, J ) 

1001050 


GOTO 955 

1001060 

954 

IX * JJ 

1001070 


IND = JJ 

1001080 


DO 964 1*1,4 

1001090 


DO 964 J*l,4 

1001100 

964 

OPENII.J) = XTEMPl 1+4, J+4) 

1001110 

955 

DO 956 1*1,4 

1001120 


JX = IND 

1001130 

> 

DO 957 J=l, 4 

1001140 

XKRTOT t IX, JX ) = XKRTOTl IX, JX) ♦ OPENII.J) 

1001150 

957 

JX = JX ♦ 1 

1001160 

956 

IX = IX ♦ 1 

1001170 

960 

CONTINUE 

1001180 

701 

CONTINUE 

1001190 


NRNG * NRINGtNRC ) 

77 

1001200 



IF (NRING(NRC).EQ.O) GO TO 210 
IF (Q.EQ.5) WRITE (6* 300 I 
300 FORMAT!///) 

MFLG- = 1 

00 211 J=1,NRNG 

CALL RINGER (Q.XN.RNGTOT .RNGLOD, J .RADUS, TAOUS, SAVJTC .SAVSTP, JTNO , 
1 KBC.XNL.MFLG.NSEG, ICYCLE.IBEGIN.LDISTL) 

JT = 4*1 JTN0(J>-1) 

DO 220 1 = 1,4 
DO 220 IK=1,4 

220 XKRTOTI JT+I, JT+IK) « XKRTOT I JT*I , JT* IK )*RNGTOTI I .IK) 

211 CONTINUE 

IF (0.NE.5) GO TO 210 
WRITE (6, 300 ) 

RE ADI 5, 2000) 

210 CONTINUE 
REWIND 2 

IFINSKL.NE.O) GO TO 931 

DO 5504 1=1, N0J4 

WRITE 1 2 ) IXKRTOTI I, J),J=1,N0J4) 

5504 CONTINUE 
GO TO 101 
931 CONTINUE 

WRITEIJO) (IXKRTOTI I. J ) , J=1,N0J4 > , I =1 ,N0 J4> 

REWIND JO 
DO 501 J=1 , NJTNH4 
DO 501 I=1,NJTNH4 
501 SKLI I , J ) =0.0 

IF (NH.EQ.O) WRITE! 6,685 1 

685 FORMAT I//60X13HSEGMENT L INKS//43X8HJ0INTI J ) 5X8HJOINT I I I5X20HANGLE 
10F ORIENTATION//) 

DO 103 NRIG = l.NSKL 
IF (Q.EO.l) GO TO 566 

REAOI 5. 503 ) JDEPI NR IG I , J INOINRIG ) , ANGLE I NRIG ) 

503 FORMAT I 212, 614. 7, 1 5A4 1 

WRITE! 1 ) JDEPI NRIG) ,J INOINRIG ) .ANGLE (NRIG) 

WRITE 1 6, 666) JDEPI NRIG) ,J INOINRIG) .ANGLE (NRIG) 

686 F0RMAT(45X,I3.10X,I3.11X,E14.7I 
IFIJINDINRIG) .GE. JDEPI NR IG ) ) GO TO 8797 
GO TO 103 

566 REAOIl) J DE P I NR I G ) , J I ND I NR I G ) , ANGLE I NR I G ) 

103 CONTINUE 

IF (Q.EQ.5) READ! 5, 2000 ) 

2000 FORMAT! IX) 

J » -3 
N * 1 

DO 100 IJ = l.NOJ 

1 « 4*1 J-3 

IFIIJ.EQ.JDEPIN) ) GOTO 11 
J = J ♦ 4 
GOTO 12 

11 JO =. JDEPI N ) 

JI = JINDIN) 

IFIN.LT .NRIG) N=N*1 

IF IS INI ANGLE IN) ) .NE.O.O) GO TO 1829 
SKLI I. J ) = 1.0 
SKLI I + l » J*3 ) =0.0 
SKLI 1+2, J*3> = 0.0 
GO TO 13 
1829 CONTINUE 

COTAN = COS I ANGLE! N ) ) /S IN I ANGLE! N ) ) 


1001210 

1001220 

1001230 

1001240 

1001250 

1001260 

1001270 

1001280 

1001290 

1001300 

1001310 

1001320 

1001330 

1001340 

1001350 

1001360 

1001370 

1001380 

1001390 

1001400 

1001410 

1001420 

1001430 

1001440 

1001450 

1001460 

1001470 

1001480 

1001490 

1001500 

1001510 

1001520 

1001530 

1001540 

1001550 

1001560 

1001570 

1001580 

1001590 

1001600 

1001610 

1001620 

1001630 

1001640 

1001650 

1001660 

1001670 

1001680 

1001690 

1001700 

1001710 

1001720 

1001730 

1001740 

1001750 

1001760 

1001770 

1001780 

1001790 

1001800 

1001810 


78 . 




SKLt I , J ) = RADUSC JD)/RADUSt JI) 

1001820 


SKL t 1+1 , J*3 ) = -tRADUSt JD)-RADUS( JI ) ) 

1001830 


SKL( 1*2, J+3) =-SKLt 1*1, J*3 )*COTAN 

1001840 


GOTO 13 

1001850 

12 

SKLT I, J) = 1.0 

1001860 

13 

SKLtI*l,J*l) * 1.0 

1001870 


SKL( 1*2, J+2 ) = 1.0 

1001880 


SKLI 1*3, J*3) 1.0 

1001890 

100 

CONTINUE 

1001900 

5000 

FORMAT I 1H ,8(E14.7.2X>/( 5X.8IE14. 7,2X) ) ) 

1001910 


II = N0J4 - 4 

1001920 


JJ ■■ NJINK4 - 4 

1001930 


WRITE! 10) 1 1 SKLt 1 1 <1 ),J=5tjJ) ,1=5,11) 

1001940 


00 702 J=1 1 NJINK4 

1001950 

702 

WRITEI2) (SKL( I. JI, I=1,N0J4) 

1001960 


WRITE! 2) it SKLt I . J ) t J = 1 tN J INK4 ) , I =1 ,N0J4 > 

1001970 


REWIND 2 

1001980 


REAOt JO) t IXKRTOTI I . J 1 . J= 1.N0J4 ) , I -1.N0J4) 

1001990 


REWIND JO 

1002000 

1000 

CONTINUE 

1002010 


DO 740 1 = 1 t NJINK4 

1002020 


READ! 2 ) (SKLTRt JJ,J=1,N0J4) 

1002030 


00 741 J=1,N0J4 

1002040 


RTEMP !J)=0.0 

1002050 


00 741 K*1,N0J4 

1002060 

741 

RTEMP t J)=RTEMP t J ) ♦SKLTRt K ) *XKRTOT t K> J ) 

1002070 


WRITE t JO) tRTEMPI J),J»1,N0J4) 

1002080 

740 

CONTINUE 

1002090 


REWIND JO 

1002100 

101 

IF tNPROB.EQ.O) GO TO 1001 

1002110 


REWIND 2 

1002120 


DO 436 I * 1 1 N0J4 

1002130 


DO 436 J=1 , NPROB 

1002140 

436 

XLRTOTt I , J)=0.0 

1002150 


DO 971 NS * ltNNT 

1002160 


JTIC * SAVJTCt NS ) 

1002170 


JSTOP» S AVSTPt NS ) 

1002180 


READ 13) i fXKEEPt I, J),J=l,NPR0B),I=l,8) 

1002190 


DO 971 N = 1,2 

1002200 


GOTO 1 98 1 . 98 2 ) . N 

1002210 

981 

II = t JTIC-1)*4 ♦ 1 

1002220 


T1I= II ♦ 3 

1002230 


GOTO 983 

1002240 

982 

II = t JSTOP-1 ) *4 ♦! 

1002250 


1 1 1= II ♦ 3 

1002260 

983 

00 971 J*l, NPROB 

1002270 


I =0 

1002280 


IF tN.EQ.2) 1=4 

1002290 


DO 971 IL * II, III 

1002300 


1 = 1*1 

1002310 

971 

XLRTOT 1 1 L, J ) = XLRTOTt ILtJ)* XKEEPtl.J) 

1002320 


IF (NRNG.EQ.O) GO TO 230 

1002330 


00 225 J=1,NRNG 

1002340 


JT • 4*t JTNOt J )-l ) 

1002350 


DO 227 1=1,4 

1002360 


DO 226 IK=1,NPR0B 

1002370 

226 

XLRTOT (JT+I.IK) =■ XLRTOT ( JT*I , IK ) +RNGLOD ( I , J ) 

1002380 

227 

CONTINUE 

1002390 

225 

CONTINUE 

1002400 

230 CONTINUE 

1002410 


REWIND 3 

1002420 




IF (NSKL.NE.O) GOTO 197 

1002930 


DO 119 1=1,9 

1002990 

119 

WRITEI3) (XLRTOTI I, J ) * J=1»NPR0B) 

1002950 


M3=NJINK9-3 

1002960 


DO 118 I=H3,NJINK9 

1002970 

118 

WRITE* 3) (XLRTOT(l*J)*J=l« NPROB) 

1002980 


M9=NJINK9-9 

1002990 


DO 117 1=5, H9 

1002500 

* 117 

WRITE ( 3 ) (XLRTOTI I, J ), J = 1 , NPROB ) 

1002510 


REWIND 3 

1002520 


GOTO 102 

1002530 

197 

DO 797 I»1,NJINK9 

1002590 


READ! 2 ) (SKLTR(J) » J=1*N0J9 I 

1002550 


DO 798 J=l, NPROB 

1002560 


STORE! I»J)=0.0 

1002570 


DO 798 K=1 ,N0J9 

1002580 

798 

STORE( I, J )=STORE( 1 * J ) ♦SKLTRIK ) *XLRTOTI K » J ) 

1002590 

797 

CONTINUE 

1002600 


DO 919 1=1,9 

1002610 

919 

WRITE ( 3 ) (STORE! I, J ),J=1, NPROB) 

1002620 


M3=NJ INK9-3 

1002630 


DO 918 I=M3,NJINK9 

1002690 

918 

WRITEO) (STORE!! « J )» J= l, NPROB ) 

1002650 


M9=NJINK9-9 

1002660 


DO 917 1=5, M9 

1002670 

' 917 

WRITEO) (STORE! I, J ),J=1, NPROB) 

1002680 


REWIND 3 

1002690 

1001 

CONTINUE 

1002700 


IF (NSKL.EQ.O) GO TO 102 

1002710 


READI2) ((SKL!I»JI*J=l*NJINK9)» I=i,N0J9) 

1002720 


REWIND 2 

1002730 


DO 750 I=1,NJINK9 

1002790 


RE AD! JO). (ROW(J), J=1,N0J9) 

1002750 


DO 751 J=1 ,NJINK9 

1002760 


REGTOT (J)=0.0 

1002770 


00 751 K=l,N0J9 

1002780 

751 

REGTOT ( J )=REGTOT (J) + ROW! K )*SKL (K* J ) 

1002790 

750 

WRITE12) (REGTOT! J) ,J=i,NJINK9) 

1002800 

C 

THE 780 LOOP REARRANGES AND PARTITIONS THE REGION 

STIFFNESS MATRIX 1002810 

102 

NJ INK = NJINK9/9 

1002820 


REWIND 2 

1002830 

. >. 

DO 625 INK=1,8 

1002890 


DO 626 J AK=1 , 8 

1002850 

626 

XK11(INK,JAK)=0.0 

1002860 


00 625 KIX=1 *M8 

1002870 


XK12 ( INK, XIX )=0.0 

1002880 

.. 

XK21IKIX, INK)=0.0 

1002890 

625 

CONTINUE 

1002900 


DO 627 K IX= 1 ,M8 

1002910 


DO 627 LAX=1,M8 

1002920 

627 

XK22(KIX,LAX)=0.0 

1002930 


NREAD=0 

1002990 


K OUNT =-8 

1002950 


NJINK3=NJINK-1 

1002960 


DO 780 N=1 , N JINK 

1002970 


NREA0=NREAD*1 

1002980 


K0UNT=K0UNT+9 

1002990 


DO 781 1=1,9 

1003000 

781 

RE ADI 2 ) (HOLD! I , J ) , J = l, NJ INK9 1 

1003010 


IF(NREAD.LE.2.0R.NREAD.GE.NJINK3)G0 TO 790 

1003020 


KK=KOUNT + 1 

1003030 


1 80 




KKK=KOUNT-f 12 
00 785 l_=KK, KKK 
1 R0W=4*( NREA0-2 ) 

J = L-4 

00 785 K=l,4 
I R0H= I R0W+ 1 

785 XK22 ( IROW, J ) =HOLD(K,L ) 

GO TO 780 

790 IFINREAO.EO. 1>G0 TO 791 
IF (NREAD .EQ« 2)G0 TO 792 
IFINREAD.EQ.NJINK3IG0 TO 793 
IFINREAO.EQ.NJINKJGO TO 794 

791 00 796 1=1,4 
DO 796 J=l,4 

XK11( I, J >=HOLD( I , J ) 

JJ=J«-4 

796 XK12(I,J )=HOLD( I , JJ ) 

GO TO 780 

792 DO 797 1=1,4 
DO 797 J=1 ,4 

XK21 ( I, J )=HOLD( I,J) 

JJ=J*4 

XK22 ( I , J ) = HOL'D! I , JJ I 
JJ J= J+8 

IFINNT . EQ.2) GO TO 795 
XK22II,jI)J3HOLOU,JJJ) 

GO TO 797 

795 XK21( I, JJ l=HOLO( I, JJJ I 

797 CONTINUE 
GO TO 780 

793 Ml 1=NJ INK4— 1 1 
M4=NJ INK4— 4 
M8=NJINK4-8 
KR0W=H8— 4 

DO 798 1=1,4 
KR0H=KR0N+1 
KC0L=4 
K8=M8-8 

00 798 J=M1 1 ,M8 
K8=K8*1 

XK22 ( KROM ,K8 l=H0L0( I , J ) 

J J= J*4 
KK=K8+4 

XK22I KROW , KK ) =HOLD<I,JJ) 

J J J=J*8 
KC0L*KC0L*1 

798 XK21 1 KROW, K COL I = HOLD I I * J JJ ) 
GO TO 780 

794 K6ND=NJ INK4-8 
KR0W=4 
H4=NJINK4-4 
M7=NJINK4-7 
DO 799 1=1,4 
KR0H=KR0W+1 
K4=KEN0-4 
KC0t=4 

DO 799 J=M7,M4 
K4=K4+1 

XK12 (KROW , K4 )=HOLD( I,J) 

KCOL=KCOl-H 

JJ«J*4 


1003040 

1003050 

1003060 

1003070 

1003080 

1003090 

1003100 

1003110 

1003120 

1003130 

1003140 

1003150 

1003160 

1003170 

1003180 

1003190 

1003200 

1003210 

1003220 

1003230 

1003240 

1003250 

1003260 

1003270 

1003280 

1003290 

1003300 

1003310 

1003320 

1003330 

1003340 

1003350 

1003360 

1003370 

1003380 

1003390 

1003400 

1003410 

1003420 

1003430 

1003440 

1003450 

1003460 

1003470 

1003480 

1003490 

1003500 

1003510 

1003520 

1003530 

1003540 

1003550 

1003560 

1003570 

1003580 

1003590 

1003600 

1003610 

1003620 

1003630 

1003640 


81 ‘ 



799 XKU ( KROW«KCOL ) =HOLD( I*JJ) 1003650 

780 CONTINUE 1003660 

7703 NS ING=NK IV*( NK IV+1 1/2 1003670 

N=NK IV 1003680 

I K=1 1003690 

00 10 K=1,N 1003700 

DO 10 I=K,N 1003710 

XK22(I*K)=( XK22 < I » K ) ♦ XK22! K, I > > /2. 1003720 

10 CONTINUE 1003730 

DO 50 K = l*4 1003740 

LEAO(K) = 1 1003750 

50 LEAD! K+4 ) * NJINK4-11 1003760 

CALL SYHSOC (XK22 , XK22,N,0, XK21, 8, LEAD, 1 12, 0.0, NIX ) 1003770 

IF (NIX.LT.O) GOTO 8841 1003780 

WRITE 110) ( (XK2HI, J ) , J= 1, 8 ) , I =1,M8 ) 1003790 

WRITE,, 1 10 ) ( ( SAVJTCU), SAVSTP ( I ) ) » 1*1 *NNT) 1003800 

DO 81 J= 1 ,8 1003810 

DO 81 1=1,8 1003820 

XK122K I , J ) = 0 .0 1003830 

DO 81 K=1 ,NKIV 1003840 

81 XK1221!I«J)=XK1221( I , J ) +XK 1 2 ( I,K)*XK21(K,J) 1003850 

DO 82 J- 1,8 1003860 

DO 82 1=1,8 1003870 

82 XKR(I,J)=XK11 (I , J I-XK122 1 ( I , J ) 1003880 

DO 650 J=1 ,7 1003890 

K = J+1 1003900 

DO 650 I=K,8 1003910 

XKR( I « J ) = ( XKR ( I , J ) ♦XKR ( J , I ) 1/2.0 ' 1003920 

650 XKR(J.I) = XKR( I , J ) 1003930 

WRITE 14) (IXKR(I,JI,J=1,8),I=1,8) 1003940 

IF (NH.NE.O. AND. IBEGIN.NE.l) GO TO 691 1003950 

WR ITE ( 6 , 5011 ) 1003960 

5011 FORMAT (////55X23HREGI0N STIFFNESS MATRIX//14X8HDELTA T17X8HDELTA Z 1003970 
11.7X.8HDELTA R1 , 7X, 7HTHETA l,8X,8HDELTA T2, 7X, 8HDELTA Z2.7X.8HDELT 1003980 

2A R2, 7X, 7HTHETA 2) 1003990 

1 1 1=0 1004000 

DO 687 M=1 ,8 1004010 

WR ITE ( 6, 688 ) ALABEL (M ) , ( XKR (M, J ) , J = 1 ,8) 1004020 

688 F0RMAT(/1X,A8,1X,8(E14.7,1XJ) 1004030 

687 CONTINUE 1004040 

691 CONTINUE 1004050 

DO 137 J=l,8 1004060 

DO 137 1=1,8 1004070 

137 SYM(I,J)*0.0 1004080 

INDEC=0 1004090 

DO 138 1=1,8 1004100 

DO 138 J = r,8 1004110 

IFIJ.NE.DGO TO 138 1004120 

IF ( XKR( I , J ) . GE.0.0 )G0 TO 138 , 1004130 

INDEC=1 1004140 

138 SYMI I, J)=XKR(l« J) 1004150 

IF C INDEC.EQ.OIGO TO 151 1004160 

WRITE (6 , 152 ) 1004170 

152 FORMAT!////* ********************************** WARNING - NEG AT I 1004180 
IVES APPEAR ON MAIN OIAGONAL. REVISE SIZING *********♦**♦**♦•//) 1004190 

151 JJ=2 1004200 

N = 8 1004210 

J = 1 1004220 

DO 42 11=1,7 1004230 

M = JJ 1004240 

DO 43 I =M,N 1004250 




ALPH = ABS ( S YM ( 1 1 J ) 1 - AB$( SYM( J, I > ) 

1004260 


IF(ALPH) 47,71,48 

1004270 

47 

IF(SYM(I,J).EQ.0.0) GOTO 71 

1004280 


SYM(I.J) = SYM(J,I) / SYHt I , J ) 

1004290 


GOTO 43 

1004300 

48 

IF(SYM(J,I>.EQ.0.0) GOTO 71 

1004310 


SYM( I , J ) = SYM( I , J ) / SYH(J,I) 

1004320 


GOTO 43 

1004330 

71 

SYM( I , J ) = 1.0 

1004340 

43 

SYM(J,I) = 0.0 

1004350 


JJ = JJ *1 

1004360 


J = J+l 

1004370 

42 

CONTINUE 

1004380 


IF (NH.NE.O. ANO.IBEGIN.NE.il GO TO 692 

1004390 


WRITE (6, 157) 

1004400 

157 

FORMAT ( //56X , 21HREGI0N SYMMETRY CHECK/1 

1004410 


DO 1730 1=1,8 

1004420 


WRITE (6 , 5000 1 ( SYM< I , J 1 , J«l, 8 1 

1004430 

1730 

CONTINUE 

1004440 

692 

CONTINUE 

1004450 


IF (NPROB.EQ.O) GO TO 150 

1004460 


DO 819 1=1,4 

1004470 

819 

READ! 3 1 ( XL 1( I,J),J = 1,NPR0B) 

1004480 


00 818 1=5,8 

1004490 

818 

READ ( 3 1 (XL1( I , J ) , J= 1 , NPROB ) 

1 004500 


D = 0.0 

1004510 


M8 = NJINK4-8 

1004520 


DO 817 1=1, M8 

1004530 

817 

RE ADI 3 1 (XL2I I , J 1 , J= 1, NPROB 1 

1004540 


LEAD! 1 1 =1 

1004550 


CALL SYMSOC (XK22,XK22,H8,0,XL2,-1, LEAD, 112, 0.0, NIX) 

1004560 


IF (NIX.LT.O) GOTO 8842 

1004570 


WRITE (10) I (XL 2 1 I*JI , J= 1, NPROB ) , 1 = 1 ,M8 ) 

1004580 


NL2=NPR08 

1004590 


DO 205 J=l, NPROB 

1004600 


DO 205 1=1,8 

1004610 


XK12L2(I,J)=0.0 

1004620 


DO 205 K=1,NKI V 

1004630 

205 

XK12L2I I, J ) = XK12L2( I,J)+XK12(.I,K)*XL2(K,J) 

1004640 


DO 206 J=l, NPROB 

1004650 


DO 206 1=1,8 

1004660 

206 

XLR( I,J ) = XL1(I,J)-XK12L2(I,J) 

1004670 


WR ITE ( 8 ) ( (XLR(I,J),J = 1,NPR0B),I = 1,8) 

1004680 


IF (NH.NE.O. AN0.I8EGIN.NE.il GO TO 150 

1004690 


WRITE(6,5012) 

1004700 

5012 

FORMAT! //57X, 18HREG ION LOAD MATRIX/) 

1004710 


DO 5512 1=1,8 

1004720 

5512 

WRITE (6, 5000) ( XLR( I, J ) , J*l, NPROB) 

1004730 


GOTO 150 

1004740 

8841 

IERR0R=8841 

1004750 


NERROR=30 

1004760 


GOTO 150 

1004770 

8797 

I ERROR = 8797 

1004780 


NERR0R=33 

1004790 


GO TO 150 

1004800 

8842 

I ERR0R=8842 

1004810 


NERR0R=31 

1004820 


GOTO 150 

1004830 

1 

READ (2) ( (XKR( I, J) ,J=1,8), 1 = 1,8) 

1004840 


00 651 J=l,7 

1004850 


K = J+i 

1004860 
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00 6S1 I-K,8 1004870 

XKR( I, J I - ( XKR ( I, J )+XKR ( J t I) 1/2.0 1004880 

651 XKR(Jtl) - XKR(I.J) 1004890 

WRITEI4) (IXKRI I, J ) , J«l , 8 ) , I- 1 , 8 ) 1004900 

IF (NPROB.EQ.O) 60 TO 150 1004910 

READI3) < (XLR(1,J),J-1,NPR0B), 1-1,8) 1004920 

- WRITEI8) IIXLRI 1, J), J-l, NPROB), 1-1,8) 1004930 

150 RETURN 1004940 

ENO 1004950 
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FOR, IS SYMSOC, SYMSOC .... 

SUBROUTINE SYMSOC ( XMAT, A , M, BANO, Y, N,LE AO.M 1D.DET ,NI X ) 1100010 

1100020 

SOLUTION OF LINEAR EQUATIONS A*X » Y, WITH POSDEF SYM BANOLI KE ’ A, -AND 1100030 
C IN-CORE Y. Y MAY BE A STANDARD DOUBLE ARRAY (ROW DIM MIDI OR A COMP- 1100040 

C ACT SINGLE ARRAY (WITH MID=0). IN EITHER CASE, LEAD(K) IS THE FIRST 1100050 

C NON-ZERO ELEMENT OF THE KTH Y-VECTOR. IF MID GT 0, THE SOLUTIONS ARE 1100C60 

C STACKEO OVER THE RIGHT SIDES. IF MID = 0, THE ROUTINE IS PRINT-ONLY. 1100070 

C 1100080 

C 1100090 

C SYMSOC CAN BE RE-ENTERED WITH NEW RIGHT SIDES BY SETTING N LT 0. 1100100 

C 1100110 

DIMENSION A( 1),Y( 1),X< 128 ) , XMAT( M ID, 1 1 .NUMBER ( 128) 1100120 

DIMENSION LEAD(l) 1100130 

INTEGER BANO 1100140 

NP = IABS(N) 1100150 

IF (N .LT. 0) GO TO 100 , 1100160 

MM = M*(M+l>/2 1100170 

CALL BANDIT (XMAT, A, M,M 1 0, NUMBER I 1100180 

CALL LLTRANI A,M, BANO, NUMBER, DET, NIX) 1100190 

IF (MID .EO. 0) WRITE (6,10) NIX, M, DET 1100200 

10 FORMAT CBERROR COOE ='I4,5X,'M =• 14, 5X , 'DETERMINANT ='IPE16.6) 1100210 

100 IF (NIX .LT. 0) RETURN 1100220 

NIX = 0 1100230 

Ml = M ♦ 1 1100240 

IF (MID .EQ. 0) GO TO 110 1100250 

INC1 = MID ♦ 1 - M 1100260 

IM = M - MID 1100270 

GO TO 120 1100280 

110 WRITE (6,20) N 1100290 

20 FORMAT('8SOLUTIONS'9X,'N *'I5) 1100300 

INC1 = 1 1100310 

IM 0 1100320 

126 CALL TRISLVIA, M.8AN0, NUMBER, X, LEAP, 1) 1100330 

DO 170 K = 1, NP 1100340 

LEAP * LEAD(K) 1100350 

DO 130 J = 1 .LEAP 1100360 

X(J) * 0. 1100370 

130 CONTINUE 1100380 

IL - IM + INC1 1100390 

IF (MID.GT.O) IL = IL+LEAP-1 1100400 

IM = MAXO(MID, MI-LEAP) + IM 1100410 

J = LEAP 1100420 

DO 140 IJ = IL , IM 1100430 

X ( J ) = Y ( I J ) 1100440 

J = J + 1 1100450 

140 CONTINUE 1100460 

CALL TRISOL (X.LEAP) 

IF (MIO .EQ. 0) GO TO 160 1100480 

J = M 1100490 

Ij = IM 1100500 

150 Y ( I J ) = X(J) 1100510 

IJ » IJ - 1 1100520 

j = J - 1 1100530 

IF (J). 170, 170, 150 1100540 

160 WRITE (6,30) K,(X(J), J = 1,M) 1100550 

30 FORMAT ('0'I5,1P8E15.6/(6X,8E15.6)) 1100560 

170 CONTINUE 1100570 

RETURN 1100580 

END 1100590 
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FOR, IS BANDIT , BANDIT 

SUBROUTINE BANDIT ( XMAT, A, N, HID, NUMBER ) 1200010 

DIMENSION XMAT < MID* 1) , NUMBER! 1 ) » A! I ) 1200020 

K * 0 1200030 

00 10 J=1,N 1200040 

DO 30 1=1. J 1200050 

IF IXMAT ! I,J).EQ.O.O) GO TO 30 1200060 

00 20 L=I,J 1200070 

K = K-fl 1200080 

20 AIK) = XMATIL.J) 1200090 

NUMBER! J) = J-I+l 1200100 

GO TO 10 1200110 

30 CONTINUE 1200120 

NUMBERIJ) » 0 1200130 

10 CONTINUE 1200140 

RETURN 1200150 

END 1200160 
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FOR, IS LLTRAN.LLTRAN 

SUBROUTINE LLTRAN! A,M, BAND, NUMBER, DET,NI X) 

CHOLESKY DECOMPOSITION OF A REAL IN-CORE POSITIVE DEFINITE MATRIX A. 

ROUTINE ASSUMES A IS STORED IN A TRIANGULAR ARRAY BY ROMS. EACH ROW 
STARTS WITH ITS 1ST NON-ZERO ELEMENT ANO CONTINUES (WITH STORAGE OF 
INTERIOR ZEROS) TO ITS DIAGONAL ELEMENT. FULL LOWER TRIANGLES AND 
DIAGONAL MATRICES GIVE NO SPECIAL TROUBLE AND THE ROUTINE IS AIMED 
PARTICULARLY AT BAND MATRICES. THE PATTERN OF STORAGE IS SHOWN BY 
THE 6X6 MATRIX BELOW. 


STORED IN THE ORDER 


WHERE A THROUGH F DENOTE 10 THROUGH 15. 


100 

110 

120 

130 


140 


150 


160 

170 

180 

190 


TO KEEP TRACK OF ZEROS, THE ROUTINE NEEDS TO BE TOLD THE NUMBER OF 
ELEMENTS STORED IN EACH ROW. THIS INFORMATION CAN BE GIVEN EXPLICIT- 
LY IN THE ARRAY NUMBER (SETTING BANO = 0 ) OR IMPLICITLY BY SETTING 
BAND TO THE NUMBER OF (COMPLETE) DIAGONALS. WITH THE 2ND CHOICE, THE 
ARRAY NUMBER IS NOT USED. IF A IS NOT POSITIVE DEFINITE, SOME LEAD- 
ING PRINCIPAL MINOR WILL HAVE A DETERMINANT LE 0, AND NIX WILL BE 
SET TO -I WHERE I IS THE FIRST SUCH MINOR. OTHERWISE L REPLACES A 
NIX = 1 INDICATES SUCCESSFUL FACTORIZATION WITH DETERMINANT OVERFLOW 
NIX = 0 INDICATES SUCCESSFUL FACTORIZATION AND THE DETERMINANT VALUE 
IS MEANINGFUL UNLESS IT HAS BEEN WIPED OUT BY UNDERFLOW. 

DIMENSION All) , NUMBER ( 1 > • S( 2 ) 

EQUIVALENCE ( SUM, SUN, S( 1 ) ) , ( SUM1 , Sf 2) ) 

INTEGER BAND 
LEALEA » 0 
LEAD1 a 0 
IK = 0 

DO 260 I * l,M 

IF (BAND) 110,100,110 
KOUNT = NUMBER! I ) 

GO TO 120 

KOUNT = MINOI I .BAND) 

LEAD = I - KOUNT ♦ 1 

IF (LEAD - LEA01) 130,190,1*0 

LAST = LEAD1 

LEAD1 = LEAD +1 

LEALEA = -LEALEA 

GO TO 150 

LAST * LEAD 

LEAD1 = LEAOl ♦ 1 

CONTINUE 

00 180 J a LEAOl, LAST 

IF (BANO) 170,160,170 
LEALEA > NUMBER! J) * LEALEA 
GO TO 180 

LEALEA = MI NO ( BAND • J ) ♦ LEALEA 
CONTINUE 

LEALEA a IABSI LEALEA ) 

KK = LEALEA 
LP a o 
LO = 1 

CALL PREFCE ( LP, LO, A ( IK>1 >, A( LEALEA ), SUN, LEAST, INC , I NDEX , KEY > 

K = LEAD 
IK a IK * 1 


1300010 

1300020 

1300030 

1300040 

1300050 

1300060 

1300070 

1300080 

1300090 

1300100 

13001i(^ 

1300120 

1300130 

1300140 

1300150 

1300160 

1300170 

1300180 

1300190 

1300200 

1300210 

1300220 

1300230 

1300240 

1300250 

1300260 

1300270 

1300280 

1300290 

1300310 

1300320 

1300330 

1300340 

1300350 

1300360 

1300370 

1300380 

1300390 

1300400 

1300410 

1300420 

1300430 

1300440 

1300450 

1300460 

1300470 

1300480 

1300490 

1300500 

1300510 

1300520 

1300530 

1300540 

1300550 

1300560 

1300570 


1300590 

1300600 


200 
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SUM = -A (IK) 

SUM1 = 0. 

K = K ♦ 1 

(.EAST = MAX0< 1.K-INC-LEA0) 
IF (BAND) 220*210.220 
210 JAZZ * NUMBER ( K ) 

GO TO 230 

220 JAZZ « M INO ( BAND. K ) 

230 INC = JAZZ - 1 

CALL HOTOOT ( SUN, LEAST. INC I 
IF (K - I) 240, 240,250 
240 A ( I K ) * -SUM / AUK) 

KK = KK ♦ JAZZ 
GO TO 200 

250 SUM = -SUM 

IF (SUM .LE. 0) GO TO 260 
DET = DET * SUM 
AUK) = SORT ( SUM) 

LEAD1 = LEAD 
260 CONTINUE 
NIX => 0 
270 RETURN 
280 NIX = -I 
GO TO 270 
END 


1300610 
1300620 
1300630 
1300640 
1300650 
1300660 
1300670 
1300680 
1 300690 
1300700 
1300710 
1300720 
1300730 
1300740 
1300750 
1300760 
1300770 
1300780 
1300790 
1300800 
1300810 
1300820 
1300830 
1300840 
1300850 
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non 


FOR, IS HOTDOT , HOT DOT 

SUBROUTINE HOTOOT IS, LOW, JUMP) 

GO TO 250 

FORTRAN VERSION NEEDS JUMP POSITIVE FOR SAFETY. 

ENTRY PREFCE ( LAST, INC, F IX, VARY, S, LOW, JUMP, I NOEX, KEY ) 
DIMENSION F IX ( 1 ) , VARY ( I ) 

INDEX =1 
KEY = 0 
GO TO 99 
250 CONTINUE 

IF (LOW-LAST) 50,50,120 
50 IJ * INOEX+L OW-l 
IF (KEY) 200,100,99 
100 DO 110 J®LOW,LAST 

S = S+VARYl IJ)*FIX(J) 

110 IJ = IJ+1 
120 INDEX = INDEX+JUMP 
LAST = LAST+INC 
GO TO 99 
200 T = S 

DO 210 J=LOW«LAST 
FIX(J) = F IX ( J ) +VARYI I J ) ♦T 
210 IJ * IJ+1 
GO TO 120 

ENTRY FOREWD ( LAST, INC, F IX, VARY, S, LOW, JUMP, I NDEX, KEY ) 
INDEX = 1 
KEY = -1 
99 RETURN 
END 


1500010 

1500020 

150003P 

1500040 

1500050 

1500090 

1500100 

1500110 

1500120 

1500130 

1500140 

1500150 

1500160 

1500170 

1500180 

1500190 

1500200 

1500210 

1500220 

1500230 


1500250 

1500260 

1500270 

1500290 

1500300 

1500310 

1500320 
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FOR, IS TRISLV * TRISLV 

SUBROUTINE TRISLV! A, M, BAND, NUMBER, Y, LEAP , LOP ) 

C SOLUTION OF LZ * Y, FOLLOWED BY SOLUTION OF LTX * Z. L IS A LOWER 
C . TRIANGULAR MATRIX STOREO BY (PARTIAL) ROWS IN THE ARRAY A. L IS AS- 
C SUMEO BANDLIKE, BUT BAND = 0 MEANS THAT THE NUMBER ARRAY GIVES THE 

C NUMBER OF ELEMENTS STOREO IN EACH ROW. FOR STORAGE ORDER SEE LLTRAN 

DIMENSION A(1)«Y(1) , NUMBER! 1 ) , S( 2 ) 

EQUIVALENCE ( SUM, SUN, S< 1 ) ) , ( SUM I, S( 2 ) ) 

INTEGER BAND 
HI * M ♦ 1 
MM1 = M - I 
RETURN 

ENTRY TRISOL (Y,LEAP) 

LOW = LOP ' 

LEAD * LEAP 
LEAD1 » LEAD + 1 
II - 0 

DO 130 I = It LEAD 

IF (BAND) 120,110,120 
110 JAZZ * NUMBER! I ) 

GO TO 130 

120 JAZZ * MINO(I.BANO) 

130 IX = II ♦ JAZZ 

IGO - II - LEAD ♦ 1 
LP * LEAO-1 

CALL PREFCE (LP , 1,Y ,A( IGO ), SUN, LEAST, INC, INDEX, KEY > 

DO 170 I = LEA01.M1 

LEAST * MAXOILEAD, I- JAZZ) 

IF( BAND) 150, 140, 150 
140 JAZZ = NUMBER! II 

GO TO 160 

150 JAZZ - M INO ( BAND, I ) 

160 INC = JAZZ - 1 

SUM = -YU-1) 

SUM1 ■ 0. 

CALL HOTDOT ISUN.LE AST, INC ) 

Y(I-l) = -SUM/A( II) 

II = II ♦ JAZZ 
170 CONTINUE 

II = II - JAZZ 
IGO = II - MM1 

CALL FOREWD !MMi ,-l ,Y, A < IGO ), SUN, LEAST, INC , INDEX , KEY ) 

I = M 

180 SUM * -YII) / A! II) 

Y(I) = -SUM 
IF! BAND) 200,190,200 
190 JAZZ = NUMBER! I) 

GO TO 210 

200 JAZZ = M INO ( I , BAND ) 

210 INC = 1 - JAZZ 

LEAST = MAXOILOW, I+INC ) 

CALL HOTOOT (SUN, LEAST, INC ) 

II = II - JAZZ 
1 = 1-1 

IF (I .GE. LOW) GO TO 180 

RETURN 

END 


1400020 

1400030 

1400040 

1400050 

1400060 

1400080 

1400090 

1400100 

1400110 

1400120 

1400140 

1400150 

1400160 

1400170 

1400180 

1400190 

1400200 

1400210 

1400220 

1400230 

1400240 


1400260 

1400270 

1400280 

1400290 

1400300 

1400310 

1400320 

1400330 

1400340 

1400350 

1400360 

1400370 

1400380 

1400390 

1400400 

1400420 

1400430 

1400440 

1400450 

1400460 

1400470 

1400480 

1400490 

1400500 

1400510 

1400520 

1400530 

1400540 

1400550 

1480560 



SUBROUTINE RINGER 


This subroutine reads the discrete ring geometric data, and temperatures, 
and forms the ring stiffness and thermal load matrices. These matrices 
are passed back to either of subroutines REGMAT or STRMAT (see next) as 
necessary, for incorporation into the region or structure matrices, 
respectively. The ring plasticity effects are calculated and the stresses 
and strains updated for each load increment. 

The calculations in RINGER account for the eccentricity of the ring 
centroid from the base shell wall, and the offset of the ring centroid 
from the shear center. 

Subroutines Sailed from RINGER 

Subroutine RITEPS : Is a routine called by RINGER to calculate the thermal 

strains throughout the ring. 

Subroutine RISULT : Is a routine called by RINGER to calculate ring stress 

resultants and moments. 

Subroutine RGSRSE : Is a routine called by RINGER to calculate ring elastic 

stresses. 
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FORTRAN CODE 

ENGINEERING SYMBOLS (REF. l) 

RNGTOT MATRIX 

N 

TDEL MATRIX 

N 

RNGLOD MATRIX 

fl ] 


N 

RC 

r 


c 

RS 

r 


s 

XC 

X 


c 

YC 

y c 
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RINGER 



c 
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FOR, IS RINGER, RINGER 

SUBROUTINE RINGER ( Q, XN, RNGTOT.RNGLOD, J , ADUS ,BADUS, J TIC , JSTOP, 

1 JTNO,KBC,XNL,HFLG,NSEG, ICYCLE, IBEGIN.LDI STL ) 

INTEGER Q,XN 

COMMON /ARING/ NR ING( 28 J , AMAT ( 30 , 8) ,RSIG 112 » ,RE PS ( 12 ) .RALPH ( 12 ) , 

C RBAPHI 12 ) 

COMMON / PLS/ OMEGA, IWORO, XMERD , XPRE S .XMONT 
COMMON /PLSTIC/ 10 , JO, IOR , JOR , KOR I ,NEO 
COMMON /CD ISP/ P,IMAX,0ELP,DELP1,YEPS,ZEPS 

DIMENSION RNGTOTI A, 4 ) , RNGLOD ( A, 28 ) , TDEL ( 4,4) , XKTOT 14 ,4 ) , XLIA ) 
DIMENSION ADUS(30),BADUS(30), J T IC ( 30 > , JSTOP ( 30 ) .JTN0I28) ,XNL(3) 
DIMENSION RNGSRNI2) ,RGSRS ( 3 ) , NPL A ( 12),DSIG( 12),DEPS( 121 
DIMENSION RT EPS ( 12 ) , TEP S< 12 ) , TEP SIN ( 3 ) ,ENTH ( 3 ) ,RGEOM (6 ) ,REPSIN(3 J 
DIMENSION AW0RD(9),JIPR<9) ,REFF( 12) ,HARDI3) ,SAVRI6> 

EQUIVALENCE (TE PS IN (l> , AMN ) , I TEPS INI 2 > , BN > 

DATA AWORD / • SREC* , • ZSEC • , • I SEC • , • HREC • , 'HTRl • , *CRRC • , *CHSC • , 

1 'TSEC', 'RASCV 

DATA HARC/* ISOT* ,'KINE», 'PERF*/ 

DATA JIPR/9,9,9, 12,9, 12, 9,6,6/ 

XI = XNLI1) 

X3 ». XNL ( 3 ) 

IF (Q.EO.l) GO TO 212 

RE ADI 5, 213) JTNOI J ) , EA, E I Y, E IX Y , E I X ,E , WORD , PHI , SIGOX ,RMOSS, RMOSN , 
1 ALPR‘,RC,XC,YC,XBAR,YBAR,TI, TO, ROJ.RHO, HARDEN, RGEOM 

213 FORMAT! 1 2 , 5E 14.7/A4, 2X, 4E 14.7/6E 12. 5/4E 14. 7,4X , A4/6E 12 .5 ) 

DO 11 K= 1,9 

IF I AWORD I K ) .EQ. WORD ) GO TO 12 

11 CONTINUE 

12 NT YP = K 

N I PR * JIPR(NTYP) 

NPLEV = 0 
DO 25 K= 1 , 3 

IF (HARD(K).EQ. HARDEN) GO TO 26 

25 CONTINUE 
NERROR = 8013 
GO TO 8888 

26 KOR = K 
KORIR = 0 

IF IKOR.GT.l) KORIR = -1 
IF I NEO.NE.O ) GO TO 600 
DO 20 Kf 1 , 12 
NPLAI K ) - 0 
RSIGIK) = 0.0 
REPS I K ) = 0.0 
REFFIK) = SIGOX 
RALPHIK) = 0.0 

20 RBAPHI K ) = 0.0 
DO 21 K= 1, 2 
RNGSRNIK ) * 0.0 
REPSINIK) = 0.0 

21 RGSRSIK) * 0.0 
RGSRSI3) = 0.0 
REPS INI 3 ) = 0.0 
C = 0.0 
IPRINT = 0 

D = 0.0 
OELR =0.0 
DO 610 K = 1 , 6 
610 SAVRIK) = 0.0 
DO 2A0 K = 1 » 3 


2900010 
2900020 
2900030 
29000A0 
2900050 
2900060 
2900070 
2900080 
2900090 
2900100 
2900110 
2900120 
2900130 
29001A0 
2900150 
2900160 
2900170 
2900180 
2900190 
2900200 
2900210 
2900220 
2900230 
29002A0 
2900250 
2900260 
2900270 
2900280 
2900290 
2900300 
2900310 
2900320 
2900330 
29003AO 
2900350 
2900360 
2900370 
2900380 
2900390 
2900A00 
2900A10 
2900A20 
2900A30 
2900AAO 
2900A50 
2900A60 
2900A70 
2900A80 
2900A90 
2900500 
2900510 
2900520 
2900530 
2 900 5 AO 
2900550 
2900560 
2900570 
2900580 
2900590 
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240 ENTH(K) = 0.0 

CALL RITEPS (RTEPS, T I ,T0, ALPR . NT VP , RGEOH ) 

[NO = 0 

CALL RISULT t TEPS IN, RTEPS, ENTH< 3 ) , NTYP , IND, RGEOH, PHI ) 

600 CONTINUE 

MR ITE( 1 ) JTNO< J ),EA,EIY, El XY,E I X ,E , NT YP ,NI PR ,PH I ,RC, XC,YC» 

1 XBAR, YBAR, ROJ, RHO, RGEOH, ALPR 

WRITE (6, 300) JTNO( J),EA, E IY, £ IXY, E I X, AL PR, E ,RC , XC , YC ,XBAR, YBAR, 

1 ROJ , T I , TO,RHO 

300 F0RMAT(/55X, 'RING AT JOINT NO. ',12//* EA = • , 1PE 12.5 ,6X, • El Y 

1 IPE12.5.5X, *EIXY * • , IPE 12. 5, 4X, • E I X * • , IPE 12. 5 ,5X, » ALPR =*, 

2 1PE12.5.4X, •£ = • , 1PE12. 5/ • RC = • , IPE 12 . 5,6X , • XC = ', IPE12. 5 , 6X, 

3 'YC =*»1PE12.5,6X, 'XBAR = » , 1PE12 . 5,4X , • YBAR = • , 1PE1 2. 5.4X, • RO =', 

4 IPE 12.5/' T I =',1PE12.5,6X,*T0 = • , IPE 12. 5, 6X, *RHO =',1PE12.5) 

GO TO 211 

212 REAO(l) JTNO( J) , EA , E I Y, El XY, EIX.E, NTYP, NIPR, PHI, RC, XC,YC, 

1 XBAR, YBAR, ROJ, RHO, RGEOH, ALPR 

211 CONTINUE 
A * EA/E 

ROH = RHO*OHEGA*OELP 

RS * RC+XC 

RCS = RC*RS 

RC2 = RC*RC 

YC2 = YC*YC 

TWOPI = 2.0*3.1415927 

RNGTOT (1,1) = 1.0/RCS*(EA*EIY/RC2) 

RNGTOT (2,1) = 0.0 
RNGTOT (3.1) * 0.0 

RNGTOT (4,1) * 1.0/RCS*(-EA*YC-EIY*YC/RC2-EIXY/RC) 

RNGTOT (1,2) = 0.0 
RNGTOT (2,2) = O.C 
RNGTOT (3,2) = 0.0 
RNGTOT (4,2) « 0.0 
RNGTOT (1,3) =0.0 
RNGTOT (2,3) = 0.0 
RNGTOT (3.3) = 0.0 
RNGTOT (4,3 ) * 0.0 
RNGTOT (1,4) = RNGTOT (4,1) 

RNGTOT (2,4) = 0.0 
RNGTOT (3,4) = 0.0 

RNGTOT ( 4,4 ) * 1 .0/RCS*( YC2*EA*E I Y*YC*E I X+2. 0*EI XY*YC /RC) 

IF (NEO.NE.O) GO TO 50 
IF (Q.NE.l) GO TO 400 

50 READ! JOR ) NPLEV, RNGSRN ,RGSR S.NPLA ,RSIG , REPS , RALPH .RBAPH, RTEPS, 

1 SIGOX,RHOSS,RHOSN,REFF,KORIR,AHN,BN,OENTH3,OOELR,SAVR, 

2 IPRINT 
K = JTNO(J) 

IF ( HFLG.EQ. 2 ) GO TO 102 

ENTH(l) = ( AHAT ( K , 1 > 4R0J-YBAR* ( AHAT(K,3)-0ENTH3 ) ) /RS 

ENTH(2)=(AHAT(K,3)-OENTH3)/RS 

ENTH(3) = AMAT(K,3> 

UELR * AHAT ( K,4 ) 

GO TO 101 

102 ENTH(l) = ( AHAT ( K,5 )*ROJ-YBAR* ( AHAT (K, 7)-0ENTH3 ) ) /RS 
ENTH(2)=IAHAT ( K, 7 1-0ENTH3 ) /RS 
ENTH(3 ) = AHAT(K,7 ) 

DELR = AHAT(K,8) 

101 CONTINUE 

IF (ICYCLE.NE.l) GO TO 180 
IF (LOISTL.EQ.l) GO TO 185 
RE AD( 5 ,2 15 ) S IGOX.RHOSS, RHOSN, TI , TO 
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215 FORMAT I5E14.7) 

CALL R1TEPS I RTEPS, TI ,TO, ALPR ,NTYP,RGEOM ) 

IND = 0 

CALL R1SULT I TEPSIN»RTEPS, ENTH I 3 ) ,NTYP» IND,RGEOM,PHI ) 

185 IF (OELP/ A8S ( OELP ) .EQ.DELP1/ABSIDELP1)) GO TO 160 
00 181 1=1,12 
NPLAII) = 0 
181 RBAPHII) = RSIGII) 

180 CONTINUE 

DDELR = DELR-ODELR 
OOMEG = ENTHI3I-0ENTH3 
D1 = DELR-YBAR*£NTH! 3) 

001 = 00ELR-YBAR4D0MEG 1 

DF1 = RNGT0TI1,1)*DD1*RNGT0TI4,1)*D0MEG+SAVRI1) 

DF2 = RNGTOT 1 1,4 )*D01+RNGT0T ( 4, 4 )*DOHEG+SA VR ( 2 1 
SAVRI5) = S AVR( 5 ) ♦OF 1 
SAVRI6) = SAVRI 6 )+0F2 

C = RNGT OTI1,1)*D1+RNGTOT(4,1I*ENTH(3) — SAVRC5) + SAVR(3) 

0 = RNGTOT ( 1,4 )*01+RNGT0TI 4,4 )*ENTHI 3)-S AVR I 6)4SAVRI 4) 

DO 483 L= 1 , 2 

483 RNGSRN(L) = RNGSRNI L )+ENTH( L ) 

DO 484 1 1=1 , NIPR 

484 TEPS(II) = OELP * RTEPSIII) 

CALL RGSRSE ( OS IG, ENTH, TEPS, E.NTYP , RGEON.PHl) 

IFINPLEV . EQ .0 ) GO TO 540 
DO 500 11=1, NIPR 
IFINPLA(II) .LE.O) GO TO 496 

IF 1 1 RSIGIII) -RALPHI II ))*OSIGIII) .LT. ZEPS) GO TO 495 
IF IRMOSN.NE.O.O) GO TO 485 
DEPS(II) = DSIG(IIl/E 
REPSIII) = REPS (II) ♦ OEPS(II) 

DSIG(It) = 0.0 
GO TO 500 

485 IF (RMOSS.EQ.O.O) GO TO 490 

TOMP = 0 .42857 143*RM0SN* I ABSI RSI Gl ID-RBAPHIII I ) /RMOSS ) **I RMOSN- 

1 1 . 0 ) 

DSIGI II )=DSIG(II )/( 1.4T0MP) 

RDSIG = DSIG(II) 

DEPSIII) = TOMP/E*OSIGI II) 

RSIG(It) = RSIG(II) ♦ DSIGI II ) 

REPSIII) = REPSIII) ♦ DEPSIII) 

IF (KORIR.EQ.O) RDSIG = 0.0 
RALPH! II) = RALPHI 1 1 )+RDSIG 
IF I KORIR.EQ.O ) REFFIII) = RSIG(II) 

GO TO 500 

490 DSIGI II) = RMQSN*DS IGI II) 

RDSIG = DSIGI II ) 

RS IGI 1 1 ) = RSIGIII) ♦ DSIGI II ) 

DEPSIII) = DSIGI II )/E*II 1.0-RMOSN)/RMDSN) 

REPSIII) = REPSIII) ♦ DEPSIII) 

IF IKORIR.EQ.O) RDSIG = 0.0 
RALPH III) = RALPHI I D+RDSIG 
IF IKORIR.EQ.O) REFFIII) = RSIGIII) 

GO TO 500 

495 NPLAtll) = -II 

496 RSIGIII) = RSIGIII) * DSIGI II > 

OEPSIII) = 0.0 

YCOND * YEPS 

IF IKORIR.EQ.O) YCOND = YCONO*REFFI ID/SIGOX 
IF I ABSI IRS IGI 1 1 ) -RALPH I II ) ) /S IGOX ) .GE. YCOND ) NPLAtll) = II 
500 CONTINUE 
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507 INO = 0 

CALL RISULT (REPS IN,0EPS,ENTH( 3) ,NTYP, IND,R6E0M,PHII 
GO TO 550 

540 00 545 1 1= 1» NIPR 

RSIG(II) = RSIG(II) ♦ DSIG(II) 

IF (ABS(RSIG(II) /S IGOX I.LT.YEPS) GO TO 545 
NPLEV =1 
NPLA (III * II 
545 CONTINUE 

REPSIN(l) * 0.0 
REPSIN(2) = 0.0 
550 IND = I 

CALL RISULT (RGSRS,RS IG« ENTH( 31 ,NTYP , IND ,RGEOM« PHI ) 

IF -I P. EO .2. I GO TO 620 
IF ( IPRI NT.EQ.O I GO TO 322 
620 PP = P-1.0 

IF (MFLG.EQ.2) GO TO 320 
WR ITE (6 1 301 ) JTNOI J ) * PP 

301 FORMAT (/34X, ‘RING AT REGION JOINT NO. •, 12, 24X, 'CYCLE * *,F5.0) 

GO TO 321 

320 WR ITE (6 , 302 ) JTNO(JI,PP 

302 FORMAT (/32X,'RING AT STRUCTURE JOINT NO. • , 12, 24X, 'C YCLE = ' ,F5.0) 

321 WR ITE ( 6, 303 ) RNGSRN ,RGSRS 

303 FORMAT (3X,'EPS THET A* • , 1PE 12. 5 ,4X , 'K THETA* ', 1PE 12.5 ,6X, 'N THETA*' 
1 , 1PE12.5,6X,'MR =',1PE12.5,10X,'MZ =',1PE12.51 

IF (NPLEV. EO.O) GO TO 322 
WR ITE ( 6, 304 ) <RSIG( IJ,I=1,NIPR) 

304 FORMAT ( / / • SIGMA = • ,7X, IP9E13 .5/15X, IP 3E 13. 5) 

WR ITE ( 6, 305 ) ( REPS! I) , 1 = l.NIPR ) 

305 FORMAT { / • EPSILON PLAS * • , 1P9E13.5/15X, IP3E13.5 ) 

322 CONTINUE 
400 CONTINUE 

TEM1 = E/RS4AMN 

RNGLOO ( 1 , J ) = DELP*TEM1+E/RS*REPSIN( 1!-X3*C 
RNGLOO( 2, J I = 0.0 
RNGLOD( 3, J I = 0.0 

RNGLOO (4, J) =0ELP*(-TEM1*YC-E/RS*BN)-E/RS*( YC*REPSIN ( 1 1+REPSIN 1 2 > ) 
1 -X3*D 

SAVR(l) * RNGLOO ( 1, J) 

SAVRI2 ) = RNGLOO ( 4, J I 
SAVR(3) = S AVR( 3 ) +S AVR( 1 ) 

SAVR(4 ) = S AVR( 4 ) +SAVRI 2 ) 

IPRINT = 0 

IF (IBEGIN.EO.l.OR.I IMAX-1 I.EQ.ICYCLE) IPRINT = 1 

WRITE! IOR) NPLEV, RNGSRN.RGSRS, NPLA ,RSIG, REPS, RALPH ,RBAPH,RTEPS, 

1 SIGOX,RMOSS,RMOSN,REFF,KORIR, AMN,BN,ENTH(3 ) , OELR, SAVR, 

2 IPRINT 
XBRS * l.O-XBAR/RS 
TOEL (1,1) * 0.0 
TDEL (2,1) * 0.0 
TDEH 3,1) = -1.0/XBRS 
T0EL(4,1I = 0.0 

TOEL (1,21 = 0.0 
TDEL( 2 , 2 ) = -1.0 
TDEL (3,2) * 0.0 
TOEL (4,2 ) = 0.0 
TDEL ( 1 ,3 ) * -1.0 
TOEL (2,3) =0.0 
TDEL (3,3) = 0.0 
TDEL (4,3) = 0.0 
TDEL( 1,4) = -YBAR 
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T0EL(2*4 I = +XBAR 
TOEL ( 3« 4 ) .= 0.0 
TDELI 4*4 ) = -1.0 
00 813 L*l,4 
DO 813 Mai* 4 
XKTOT ( L*H ) =-0.0 
DO 813 N=l«4 

813 XKTOTIL.H) * XKTOT !L»M ) ♦RNGTOT CL ,N) *TDEL<N.M> 
00 814 L=i *4 

00 814 M=1 *4 
RNGTOT(L.N) = 0.0 
00 814 N=1 *4 

814 RNGTOT I L»H) = RNGTOT ( L,H >*TDEL ( N, L »*XKTOT ( N , M ) 
00 815 L=l»4 

XL ( L ) * 0.0 
DO 815 N=1 *4 

815 XL ( L ) * XL(L)+TDEL(N*LI 4RNGL0D (N • J ) 

00 816 L=l»2 

816 RNGLODiLtJ) = XL ( L > 

B = -ROM*RC*A 
RNGLOO ( 3 * J ) = XL I 3 ) +B 
RNGLOO 1 4 * J ) « XL (4) ♦YBARtB 
00 1100 L= 1* NSEG 

IF (JTNO(J).EQ.JTIC(L)) GO TO 1105 

1100 CONTINUE 
GO TO 1107 

1105 M = JTICIL 1 

RMULT = AOUS ( M) *TWOPI 
GO TO 1111 

1107 DO 1101 L= 1 * NSEG 

IF ( JTNO ( J ) . EQ. JSTOPI L ) ) GO TO 1106 

1101 CONTINUE 

1106 M = JSTOP(L) 

RHULT = BADUS(H)*TMOPI 
1111 CONTINUE 

DO 820 L=l»4 
00 820 M-1,4 

820 RNGTOT (L* H) * RNGTOT ( L. H )*RMULT 
DO 821 L-1,4 

821 RNGLOOfL* J I « RNGLOO! L* J >*RMULT 
402 RETURN 

8888 NIX = 1 

GO TO 402 
END 
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non ooo non 


FOR, IS RITEPS.RITEPS 

SUBROUTINE RITEPS < RTEPS, TI ,T0, ALPR.NTYP, RGEOM t 
COMMON /GINT/ AA(8,4) ,WN(8,4) 

DIMENSION RTEPSI 1 )» TEMPI 4 ) .RGEOMI 1) 

PI = 3.14159265 
TEMPI l ) “ IT I-T0I/2.0 
TEMPI 2 ) “ IT I*TO 1/2.0 

GO TO 1 100,200,200,300,400,500,200,600,600) »NTYP 
SOLID RECTANGULAR SECTION 


100 RTEPSI 1 1 
RTEPSI2 I 
RTEPSI 31 
RTEPSI4) 
RTEPSI 5 I 
RTEPS16) 
RTEPSITJ 
RTEPSI8) 
RTEPSI 9) 
GO TO 990 


» ALPR* I TEMPI 1 ) *AA( 3, 1 )>TEMPl 2 ) ) 

“ RTEPSI II 

* RTEPSI 1 ) 

= ALPR* I -TEMPI l )*AAI 3, 1 l+TEMPI 2 > ) 
“ RTEPSI 41 
“ RTEPSI4) 

* ALPR*TEMP(2) 

“ RTEPSI7) 

* RTEPSI 71 


2-SECTION , I -SECTION OR CHANNEL SECTION 


200 D£NO=RGEOMI 1 )*RGE0M(4 ) ♦RGEOMI 2 ) *RGEOMI 5 I+RGEOMI 3 >*RGE0M( 6) 

XI “RGEOM (2)/2.*t RGEOMI 3 1 *RGEOM I 6 )— RGEOM 1 1 )*RGE0MI4I ) /DENO 
TEMP(3)=2.*TEMP( 1) /RGEOMI 2) 

TEMP 14 ) “RGEOMI 2 ) /2.-X1 
RT EPS 1 7 I =ALPR*T 1 
RT EPS 1 8 1 “RTEPSI 7 ) 

RTEPS(9»=RTEPS<7> 

XT “RGEOM (2)/2.*AA(3,l I— X 1 
TT=TEMPI 3>*IXT-TEMPI4I »*TI 
RTEPS 14 ) “ALPR*TT 
XT “—RGEOMI 2)/2.*AAI3,l)-Xl 
TT=TEMP 131*1 XT-TEMP 1 4 1 1 +TI 
RTEPS 15 ) “ALPR*TT 
XT“-Xi 

TT=TEMPI 3 ) *1 XT-T EMP 1 4 ) I +TI 
RTEPS 1 6 ) =ALPR*TT 
RTEPS 1 1 ) = ALPR*TO 
RTEPS(2»=RTEPSI 1) 

RTEPSI 3 ) “RTEPSI 1 ) 

GO TO 990 

HOLLOW RECTANGULAR SECTION 

300 XI “RGEOM 1 1 )*RGEQMt 2 )/ 2.* I RGEOM I 5 ) -RGEOM 13)) / (RGEOM II »*(RGE0N(3) 
1 ♦RGEOMI 511+2. *RGE0M(2)*RGE0M(4I ) 

TEMP(3)=2.*TEMPI D/RGE0MI2I 
TEMP ( 4 ) “RGEOMI 2 ) /2.-X1 
RTEPS 1 7 > =ALPR*T I 
RTEPS(8»“RTEPS(7I 
RTEPS19)=RTEPS(7» 

XT=RGEOM (2)/2.*AA(3,l)-Xl 
TT “TEMP I 3 J *1 XT-TEMP (4 ) ) + TI 
RTEPS (4 1 “ALPR*TT 
XT=-RGE0M(2)/2.*AA( 3, 1 »-Xi 
TT=TEMP(3)*I XT-TEMP (4 ) l+TI 
RTEPSI5) “ALPR*TT 
XT“-Xl 

TT=TEMP( 3 ) * I XT-TEMP 14 1 l+TI 
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non non 


RTEPS(6)=ALPR*TT 
RTEPS (1 ) =ALPR*TO 
RT EPS ( 2 )= RTEPS ( 1 ) 

RT EPS ( 3 ) =RTEPS( 1 ) 

RTEPS 1 10 ) = RTEPS t 4 ) 

RTEPS (11) * RTEPS< 5 ) 

RTEPS( 12 ) * RTEPSU) 

GO TO 990 

TRIANGULAR SECTION (ISOSCELES) 

400 RTEPS (4) a TI*ALPR 
RT EPS ( 5 ) = RTEPS ( 4 ) 

RTEPS ( 6 ) « RTEPS ( 4 ) 

XI = RGEOM ( 1 ) *RGE0M ( 1 ) 4RGE0MC 3 ) 

ST » RGEOM C 2 1/ ( 2 .0*RGE0M ( 1 ) ) 

CT = SQRT(1.0-ST*ST) s , 

X2 = 2 .0 *RGE0M( 1 ) *RGE0M( 3 ) 4RGEOMI 2 )*RGE0M( 4 ) 

XI = X1*CT/X2 

X2 = -RGE0M( 1 )*CT*( RGEOM ( I ) *RGE0MC 3 ) +RGEOM( 2 )*RGE0M( 4) )/X2 
TEMPO) = (XI+X2 )/2.0 
TEMPI 4 ) = ( X 1-X2 )/2 .0 
X = TEMP(3)*AA(3»1) +TEMP ( 4 ) 

0 = TEMP(1)/TEMP(4) 

RTEPSU) = ( Q*( X-Xl )+TI )4ALPR 
RTEPS (7 ) = RTEPSU) 

X * -TEMP(3)*AA!3, IHTEMPUI 
RTEPS (2) = !Q*(X-X1)4TI)*ALPR 
RTEPS ( 8 ) = RTEPSU) 

X = TEMP ( 4 ) 

RT EPS ( 3 ) = ( Q*( X-Xl )+T I ) *ALPR 
RTEPSI9) = RTEPS (-3 ) 

GO TO 990 

CRRC SECTION 

500 RTEPSU) = ALPR*T I 
RT EPS ( 2 ) = RTEPSU) 

RTEPSU) = RTEPSU) 

XI = ( 2 • 0*RGE0M( 1 )* RGEOM ( I ) *P I 4RGE0MI 2 )* (RGEOM! 1 )+RGE0M( 2 ) /PI ) ) * 

1 RGEOM ( 3 )/ ( ( 4.0*RGE0M( 1 )4P I*R6EOM( 2 ) )*RGE0M ( 3) +2 .0*RGE0M (2 ) * 

2 RGE0M( 4 ) ) 

X = X1+RGE0MI2 )/2.0*(AA(3*l> - 1.0) 

X2 a XI - ( RGEOM ( l)+RGE0M(2)/2.0) 

TEMPO) = ( X I+X 2 ) /2 .0 
TEMP (4 ) = (XI-X2 1/2.0 
0 = TEMPU J/TEMP(4) 

RT EPS ( 4 ) = (0*(X-X1)4TI)*ALPR 
RT EPS( 7 ) = RTEPS (4 ) 

X = XI-RGE0M(2)/2.04(AA(3. 1)*1.0) 

RTEPS (5 ) a (Q*(X-X1)+TI)*ALPR 
RTEPSU) a RTEPS ( 5 ) 

RTEPS (6 I = (-Q* RGEOM! 2 l/2.0+TI)*ALPR 
RTEPS (9) a RTEPS! 6) 

THETA = PI/2.0*(1.0+AA(3«1)> 

X = X1-RGEOM(1)-RGEOM(2)/2.0«'SIN(THETA) 

RT EPS ( 10 ) a (Q*(X-X1)4T I )*ALPR 
THETA = PI/2. 0*(1.0-AA( 3.1) ) 

X = X1-RGEOM(1)-RGEOM(2)/2.0*SIN( THETA) 

RT EPS (11) = <Q*(X-X1)+TI >*ALPR 
X = Xl-RGEOMd ) -RGEOM ( 2 ) / 2. 0 
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RTEPS(12) = <Q*(X-X1MTI)*ALPR 
GO TO 990 

T-SECT ION OR RIGHT ANGULAR SECTION 

600 X1*>RGE0M(2)/2.*(RGE0MI2)*RGE0M( AH-2.*RGEOMCl>*RGEOH( 3 ) ) / ( RGEOM (2 ) 
1 *RGEOM( 4 ) +RGEOH ( 1 ) ♦RGEOM ( 3 ) ) 

TEMPI 3 l=2.*TEMP ( 1 1 /RGEOM { 2 ) 

RTEPS ( 1 )»ALPR*TQ 
RT EPS (21 - RTEPS(l) 

RTEPSI3J =* RTEPS(l) 

XT=RGEOM (2)/2.*(AA(3,l)-l.)+Xl 

TT=TEMP(3»*(XT-X1)ATI 

RTEPS ( A )=ALPR*TT 

XT=— RGEOM( 2 )/2.*(AA(3tI)+l. I+Xl 

TT=TEMP( 3 ) *( XT— XI )+TI 

RTEPS ( 5 ) =ALPR*TT 

XT®— RGEOM ( 2 1 / 2. + XI 

TT=TEMP(3 I *( XT-X1 > ♦ T I 

RTEPS (6 )=ALPR*TT 

990 RETURN 
ENti 
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FOR, IS RISULT,RISULT 

SUBROUTINE RISULT ( R6SRS , S IG, ENTH.NTYP, IND, RGEOM.PHI ) 

COMMON / GINT/ AA ( 8, 4 ) , WW 1 8, 4 ) 

DIMENSION RGSRSl I),SIGI U , TEMP ( 2 > ,RGEOM C l ) 

II = 1 

PI * 3.14159265 
ANG = PHUENTH 
TEMPI 1 ) = COSIANG) 

TEMPI 2 ) = SINt ANG) 

RGSRSI1) = 0.0 
RGSRSl 2 ) = 0.0 

IF (IND .NE.O) RGSRSl 3 ) * 0.0 

GO TO (100, 300, 400, 600, 200, 500, 700, 800, 900), NTYP 

SOLID RECTANGULAR SECTION 

100 DO 140 L=1 ,2 

XT = RGEOMI 1)/2.0*AA(3,L) 

110 DO 130 LL=1 » 2 

YT = RGE0MI2 )/2.0*AA( 3,LL ) 

120 RGSRS(l) = R GSRS 1 1 ) ♦ WW13,L) * WWI3.LL) * SIGIII) 

RGSRSI2) = RGSRSl 2 ) - WW13.L) * WHI3.LL) * SIGIII) *l-XT*TEHPll) ♦ 
1 YT * TEMPI 2 ) ) 

IF (IND. NE.O) RGSRSI3) = RGSRSl 3 » - WN(3,L) * HWI3 ,L L) *S IGI 1 1 ) * 

1 (XT * TEMPI 2) ♦ YT * TEMPI 1)) 

II = II+l 

I F ( YT .LE.O.O) GO TO 130 
YT = -YT 
GO TO 120 
130 CONTINUE 

IF (XT .LE. 0.0) GO TO 140 
XT = -XT 
GO TO 110 
140 CONTINUE 

FACT = RGEOMI 1 )* RGEOMI 2 1/4.0 

RGSRS ( 1 ) = RGSRSU) * FACT 

RGSRSl 2 ) = RGSRSl 2 ) * FACT 

IFIIND .NE.O) RGSRS ( 3 ) = RGSRS ( 3) * FACT 

GO TO 990 

TRIANGULAR SECTION (ISOSCELES) 

200 CONTINUE 

XI = RGEOMI 1 )*RGEOM( 1)*RGE0M( 3) 

ST = RGEOM ( 2 1/2 .JO/RGEOM< 1 ) 

CT = SORT ( 1 .0-ST*ST ) 

X2 = 2 . 0*RGEOM( 1 ) *RGEOM (3)+RGE0M(2(*RGE0M(4) 

XI = Xl*CT/2 .0 

X2 = RGEOM ( 1 )*CT*(RGEOM( 1)*RGE0M(3 J+RGEOM ( 2 )*RG£0M(4 ) ) /X2 
DO 230 L=l, 2 
SI = AA ( 3 , L ) 

210 RGSRS ( 1 ) = RGSRS ( 1 ) +WW( 3,L)4( ( SIG( II ) + SIG( II *6) )*RGE OM ( 1 )*RGEOM( 3 ) 
1 +SIG< I l+3)*RGE0M ( 2 ) *RGEOH (4) 1/2.0 

YT = -RGE0M(2)/2.0*SI 

RGSRS (2) = RGSRSl 2 )-MW ( 3,L ) 4RGE0MI 2 ) *RGEOM( 4 )*SIGl II+31/2.0* 

1 (-X1*TEMP( 1I+YT*TEMP(2) ) 

XT = (Xl-X2)/2.0-(X2+XU/2.0*SI 
YT = RGE0M(2)/2.0*( 1.0-SI) 

RGSRSl 2) = RGSRS l 2 )-WWl 3,L)*RGEOMll)*RGE0M(3)*SIGlII)/2.O* 

1 ( -XT*TEMP (1)+YT*TEMP12)> 


3100010 
3100020 
3100030 
3100040 
3100050 
3100060 
3100070 
3100080 
3100090 
3100100 
3100110 
3100120 
3100130 
3100140 
3100150 
3100160 
3100170 
3100180 
3100190 
3 100200 
3100210 
3100220 
3100230 
3100240 
3100250 
3100260 
3100270 
3100280 
3100290 
3100300 
3100310 
3100320 
3100330 
3100340 
3100350 
3100360 
3 100370 
3100380 
3100390 
3100400 
3100410 
3100420 
3100430 
3100440 
3100450 
3100460 
3100470 
3100480 
3100490 
3100500 
3100510 
3100520 
3100530 
3100540 
3 100550 
3100560 
3100570 
3100580 
3100590 



on o o o o 


YT = -YT 

RGSRSJ2) = RGSRS ( 2 ) -MW( 3 »L I *RGEOM ( 1 ) *RGEOM( 3)*SIG!II+6)/2.0* 

1 l-XT*TEMP! 1)+YT*TEMP! 2 ) I 

IF 1IND.EQ.0I GO TO 220 
YT =» -RGE0MI2)/2.0*SI 

RGSRS ( 3 I = RGSRS C 3 I-WW! 3»L)*RGE0M 12) *RGEOM(A)*SIG(II ♦31/2.0* 

1 ! X1*TEMP! 2 )*YT*TEMP< I I 1 

XT * !Xl-X2I/2.0-!X2'*Xl)/2.0*SI 
YT = RGEOM! 2 )/2.0*( I.O-SIl 

RGSRS 1 3 ) = RGSRS ( 31 -WW1 3»L ) ♦RGEOM <I)*RGE0M(3)*SIG(II )/2.0* 

1 ( XT*TEMP ( 2 l+YT*TEMP 1 1 ) ) 

YT « -YT 

RGSRS ! 3 ) = RGSRS! 3)-WH( 3,L )*RGEOM (1) ♦RGEOM < 3 I *S IG ( II +6 1/2.0* 

1 • <XT*T£HP<2)*YT*T£MP! I)) 

220 II = II+l 

IF ISI.LE.O.0) GO TO 230 
SI = -SI 
GO TO 210 
230 CONTINUE 
GO TO 990 

Z-SECT ION 

300 OENO=RGEOH( 1 ) *RGEOM ( A ) +RGEOM ( 2 ) ♦RGEOM! 5 > ♦RGEOM! 3 I ♦RGEOM! 6 ) 
Xl=RGE0M(2)/2.*( RGEOM! 3 ) *RGEOM < 6 1 -RGEOM tl)*RGEOM!A)) /DENO 
Yl= ( RGEOM ( 1 ) ♦♦2*RGE0MI A I-RGEOM ( 3 )**2*RGE0N (6)1/2. /OE NO 
X2=-RGE0M 121/2. -XI 
X3=RGE0M ( 2 I /2.-X1 
00 330 L = l,2 
SI = AA I 3 • L ) 

310 RGSRS ! 1 1 » RGSRS ! 1 ) ♦ WHO, LI ♦ (SIG1III * RGE0HI1) * RGEOM! A) 

1 ♦ SIGI 1 1+3 1 * RGEOM ( 2 1 * RGE0MI5I 

2 ♦ SIG! 11*6) * RGEOM! 31 * RGEOM! 6 1 ) /2 .0 
YT=RGE0M(1)/2.*!1.*SII-Y1 

RGSRS ( 2 ) = RGSRSI2)-WW13,L) * SIG1II) / 2.0ARGE0MUI * 

1 RGE0M(4I*!-X1*TEMP!1)*YT*TEMP!2) I 
YT=RGE0M!2 I/2.+SI-X1 

RGSRS ! 2 ) = RGSRS ! 2 1 ♦ WH!3,L) * SIGIII + 3) / 2.0 * RGEOM! 2) * 

1 RGEOM ( 5 I *( -YT*TEMP !1)-Y1*TEMP!2) I 
YT=-RGE0M!3)/2.*! l.-SI I-Yl 

RGSRS 12 ) = RGSRS! 2) - WH13.L) * SIGIII+6) / 2.0 * RGEOM ( 3 ) * 

1 RGEOM 1 6 I ♦! -X3*TEMP 1 1 1+YT^TEMP I 2 ) I 
IF ! IND . EQ.O I GO TO 320 
YT=RGE0M!l)/2.*! 1.+SII-Y1 

RGSRS! 3 ) = RGSRS! 3) - WW!3,U * SIGIII) / 2.0 * RGEOM! 1) * 

1 RGEOM ! A I* ( X1*TEMP! 2 1 *YT*TEMP <1)1 
YT=RGE0M(2)/2.*SI-Xl 

RGSRS ! 3 1 *■ RGSRS! 3) - WWI3,L) * SIG1II + 3J / 2.0 * RGEOM! 2) * 

1 RGEOM! 5)*!YT*TEMP!2)-Y1*TEMP!1) I 
YT=-RGEOM 131/2. ♦!-!. -SI) -Y1 

RGSRS ! 3 ) = RGSRS! 3) - WW13.L) * SIG!II*6> / 2.0 * RGEOM! 3 ) * 

1 RGE0M(6)*(X3*TEMP12)+YT*TEMP! 1) I 
320 II = II + 1 

IF (S I .LE .0.0 1 GO TO 330 
SI = -SI 
GO TO 310 
330 CONTINUE 
GO TO 990 

I- SECTION 


3100600 
3100610 
3100620 
3100630 
31006A0 
3100650 
3100660 
3100670 
3100680 
3 100690 
3100700 
3100710 
3100720 
3100730 
31007AO 
3100750 
3100760 
3100770 
3100780 
3100790 
3100800 
3100810 
3100820 


31008A0 

3100850 

3100860 

3100870 

3100890 


3100920 


3100950 
3100970 
3 100990 


3101020 


3101050 

3101070 
3101080 
3101090 
3101100 
3101110 
3 101120 
3101130 
3 10 1 1A0 
3101150 
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400 X1=RGE0H( 2 ) / 2.*( RGEOH ( 3 ) *RGEOH (6 I-RGEOH ( 1 )*RGEOH (4 ) ) / ( RGEOH! 1 )* 

1 RGEOH ( 4 ) +RGEOH! 2 ) *RGEOH( 5 ) +RGEOH ! 3 ) *RGEOH( 6 ) ) 

X2=RGE0H (2J/2.-X1 
X3=-RGE0H< 21/2.-X1 
00 430 L = 1 » 2 
SI * AA( 3»L ) 

410 RGSRS(l) = RGSRS(l) ♦ HH(3,U * (SIG(Il) * RGEOH ( l ) * RGEOH ( 4 ) 

1 + SIGUI+3J * RGE0HI2 ) * RGE0M(5) 

2 ♦ SIG(II+6) * RGEOH ( 3 ) * RGEOH! 6 ) ) / 2.0 
YT = RGEOH! 1 ) * SI / 2.0 

RGSRS ! 2 ) = RGSRSI2) - WW!3,L) * SIGfll) / 2.0 * RGEOH! 1 ) * 

1 RGE0H(4)*(-X3*TEHP!1)+YT*TEHP!2) ) 

YT=RGE0H!2 )*SI/2.-Xl 

RGSRS! 2 ) = RGSRS! 2 ) ♦ WW!3,L> * SIG1II+3) / 2.0 * RGEOH! 2) * 

1 RGE0H15) * YT * rEHP!l) 

YT = RGEOH! 3 ) * SI / 2.0 

RGSRSI2) * RGSRS! 2) - WW(3,L) * SIG1II+6) / 2.0 * RGEOH! 3 ) * 

1 RGEOH 16 1*!-X2*TEHP( l)+YT*TEHP(2) ) 

IF (IND .EQ. 0) GO TO 420 
YT = RGEOH! 1 ) * SI / 2.0 

RGSRSI3J = RGSRS ! 3 ) - WWI3.U * SIG(II) / 2.0 * RGEOMIll * 

1 RGEOH! 4 ) *( X3*T EHP! 2 ) +YT*T EHP ! 1 ) ) 

YT=RGE0H(2)*SI/2.-Xl ' 

RGSRS ( 3 ) = RGSRS! 3) - WWI3.L1 * SIGIIU3) / 2.0 * RGEOH! 2 ) * 

1 RGEOH! 5> * YT * TEHP! 2 ) 

YT = RGEOH 1 3 ) * SI / 2.0 

RGSRS ! 3 ) = RGSRS ( 3 ) - WW!3,L> * SIGIII+6) / 2.0 * RGEOH! 3) * 

1 RGE0H!6)*(X2*TEHP12i+YT*TEHP(l)) 

420 II = II+l 

IF (SI .LE.O.O) GO TO 430 
SI - -SI 
GO TO 410 
430 CONTINUE 
GO TO 990 

CRRC SECTION 

500 CONTINUE 

XI = ( 2. O+RGEOH ( 1 )*RG£OH ( 1 ) +P I*RGEOH( 2)*(RGE0H!1) ♦RGEOH! 2 ) / PI ) )* 

1 RGEOH (34/1 !4.0*RGE0H( 1 » + P I*RGEOH! 2 ) >*RGEOH(3)+2 .0*RGE0H(2>* 

2 RGEOH (41) 

DO 530 L-l * 2 
SI = AA(3,U 

510 RGSRS ( 1 1 = RGSRS ( 1 ) +WW! 3»LI/2.0*( SIG! II )*RGEOH ( 2 )*RGEOH( 4 ) ♦ 

1 (SIG! 1 1+3) ♦SIG! II+6))*RGE0H(l)*RGE0H!3>*SIG(II+9)* 

2 RGEQH!2l*RGE0H!3)*PI/2.0) 

XT = XI 

YT = -RGEOH! 2)/2.0*SI 

RGSRS! 2 ) * RGSRS(2)-WW(3»L)*SIG(II)/2. 0*RGE0H( 2 ) *RGE OH (4 ) * 

1 !-XT*TEHP<l>+YT*TEHPI 2) > 

XT = RGEOH! 1 )/ 2 .0*! S I- 1 .0 > +X l 
YT = RGEOH! 2 1/2.0 

RGSRS ( 2 ) = RGSR$(2>-WW(3,LI*SIG( 1 1+3 »/2.0*RGE0H( D*RG£OH ( 3 >* 

1 !-XT*TEHP! l)+YT*TEHP( 2) ) 

YT = -YT 

RGSRSI2 ) ■» RGSRS(2)-WW!3tU*SIG(II + 6>/2.0*RGEOH(l»*RGE0H(3»* 
l !-XT*TEHP( 1I+YT*TEMP( 21 > 

THT = PI/2.0*! 1.0+SI) 

XT o X1-RGEOH!1)-RGEOH!2)/2.0*SIN(THT) 

YT * RGEOH! 2 l/2.0*C0S! THT ) 

RGSRSI2) * RGSRS I 2 )-HH! 3»L )*S IG! I 1+9 >/4. 0*RGE0H ( 2 ) *RGEOH (3 ) *PI* 


3101170 

3101180 

3101190 

3101200 

3101210 

3101220 


3101250 

3101260 

3101270 

3101280 

3101300 

3101310 

3101320 


3101350 

3101360 

3101370 

3101380 

3101400 

3101410 

3101420 

3101430 

3101440 

3101450 

3101460 

3101470 

3101480 

3101490 

3101500 

3101510 

3101520 

3101530 

3101540 

3101550 

3101560 

3101570 

3101580 

3101590 

3101600 

3101610 

3101620 

3101630 

3101640 

3101650 

3101660 

3101670 

3101680 

3101690 

3101700 

3101710 

3101720 



non non 


l !-XT*TEMP!l)+YT*TEMP!2)) 

IF (IND.EQ.O) GO TO 520 
XT = XI 

YT = -RGEOMI 21/2.0* SI 

RGSRSI3) = RGSRS(3)-WW!3,L)*SIG(II>/2.0*RGE0MI2>*RGE0M(A>* 

1 (XT*TEMP(2)+YT*TEMP(1 ) ) 

XT = RGEOM(1)/2.0*ISI-1.0)+RGEOM( II 
YT = RGEOMI 2 )/2 . 0 

RGSRSI3) = R GSRS I 3 )-WW! 3 . L ) *S I G( II+3I/2 .0*RGE0M! 1 ) *RGE0M 1 3 ) * 

1 I XT*T EMP I 2 ) +YT*TEMP I 1 ) ) 

YT = -YT 

RGSRS13) = RGSRS 1 3)-WW(3*L)*SlG(II+6)/2. 0*RGEOM 1 1 ) *R GEOM I 3 )* 

1 I XT*TEMP 1 2 ) +YT*TEMP I 1 ) ) 

XT = Xl-RGEOMI 1 ) -RGEOM (2)/2.0*SIN(THT) 

YT = RGEOM 1 2 )/2 . 0*CQS I THT I 

RGSRS 1 3 ) = RGSRS(3)-WW(3,L)*SIG< II+9 )/A . 0*RGEOM 1 2 >*R GEOM 1 3 ) * 

1 PI*(XT*T£MP( 2I+YT*TEMP( l > ) 

520 II = II+l 

IF ISI.LE.O.O) GO TO 530 
SI = -SI 
GO TO 510 
530 CONTINUE 
GO TO 990 

HOLLOW RECTANGULAR SECTION 

600 X1=RGE0M 1 1 )*RGEOM( 2 ) /2. * I RGEOM 1 5 1 -RGEOM 1 3 ) )/IRGEOMtl )*!RGE0M!3> 

1 ♦RGE0MI5) )+2.*RGE0M(2)*RGE0M( A) I 
X2=RGE0M! 2 1/2. -XI 
X3=-RGE0M I2I/2.-X1 
DO 630 L=l,2 
SI = AAI3.L) 

610 RGSRS I 1)=RGSRS( 1 J+WWI 3,L )*I RGEOMI l ) *RGEOM 1 3 ) *SI G 1 1 1 > 

1 ♦ RGEOM III *RGEOM ( 5 ) *SIG ( 11^6 1 +RGEOM! 2 ) *RGEOM ( A ) * I S IG I 1 1 + 3 ) 

2 +SIG 1 1 1 +9 ) ) 1/2.0 N ~ 

YT = RGEOMI 1 ) ♦ SI / 2.0 

RGSRS(2)=RGSRSI2)-WHI3»L )*( SIG (II )* I-X3*TEMP I 1 ) +YT*T EMPl 2 ) ) *RGEOM 
I (31+SIGI II+6)*I-X2*TEMPU»+YT*TEMP12) )*RGEOM| 5 ) )*RGEOM( 1 ) /2. 

YT = RGEOM (2)*SI/2.-Xl 

RGSRS 1 2 ) = RGSRS! 2 ) - WWI3.L) * (SIGIII+3) * IRGEOMU) * TEMP 12 ) / 

1 2.0 - YT * TEMPI 1)) + SIGtII+9) * I-RGEOMU) * TEMPI 2 ) 

2 / 2.0 - YT * TEMPIim * RGE0MI2) * RGEOM (A ) / 2.0 

IF I IND.EQ.O) GO TO 620 

YT = RGEOMI 1) * SI / 2.0 

RGSRS(3) = RGSRSI3 )— WWI 3, LI* I SIGI II )* I X3* TEMP I 2 ) ♦ YT*TE MP 1 1 ) )* 

1 RGEOMI 3)+SIG(II+6)*(X2*TEMP(2)+YT*TEMPtl))*RGEGM(5> )*RGEOM( l)/2. 
YT=RGE0M(2 J*Sl/2.-Xl 

RGSRS ( 3 ) = RGSRS! 3) - WW(3,L) * (SIGIII+3) * I YT * TEMP(2> ♦ 

1 RGEOMI 1)/2.*TEMP I 1 ) ) +S I G I 1 1 +9 )* I YT* TEMP 1 2 )- 

2 RGEOM! l)/2.*TEMPI 1 ) I )*RGEOHI 2 ) *RGEOM( A ) /2. 

620 II = II+l 

IF ISI.LE.O.O) GO TO 630 
SI = -SI 
GO TO 610 
630 CONTINUE 
GO TO 990 

CHANNEL SECTION 

700 CONTINUE 

DEN0=RGE0M(1 >*RGEOM< A ) ♦RGEOMI 2 ) *RGEOM( 5 ) ♦RGEOMI 3 >*RGEOM( 6 ) 


3101730 

31017AO 

3101750 

3101760 

3101770 

3101780 

3101790 

3101800 

3101810 

3101820 

3101830 

31018A0 

3101850 

3101860 

3101870 

3101880 

3101890 

3101900 

3101910 

3101920 

3101930 

31019A0 

3101950 

3101960 

3101970 

3101980 


3102000 


31020A0 


3 10 2090 
3102100 
3102110 
3102120 
3102130 


3102180 


3102210 

3102220 

3102230 

31022A0 

3102250 

3102260 

3102270 

3102280 

3102290 

3102300 
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non 


Yl = ( RGEOM! 1 ) **2*RG£0MI4 ) -t-RGEOM ( 3 ) **2*RGE0M( 6 ) ) / 2./DEN0 
X1=RG£0M(2)/2.*I RGEOM( 3 ) *RGEOM I 6 ) -RGEOM I 1 )*RGEQM (4 ) ) /DENO 
00 730 L = 1 * 2 
SI = A AI3.L) 

710 RGSRSI l>=RGSRSm+WWI3,L)/2.*tSIG(m*RGE0M(l)*RGE0MI4)4SIGIII+3) 
1 *RGE0H!2)*RGE0H(5)*SIG! l H-6)*RGE0M< 3>*RGE0MI6) > 
XT=-RGE0H(2)/2.-Xl 
YT = RGEOM! 1 )/2. 0*1 SI-1. 01+Y1 

RGSRSI 2)=RGSRS( 2 )-WW( 3,L )*SIG I II) /2.0*RGE0M II) *RGE0N 14 )* 

1 < -XT *T£MP( 1 )+YT*T£MP( 2 ) ) 

XT =RG60M ( 2 )/ 2.-X 1 
YT=RGE0MI3)/2.*(SI-1. KYI 

RGSRS 1 2 ) =RGSRS( 2 )-WW! 3»L)*SIG(II *6 )/2.*RGEOM ( 3 ) *RGE0M( 6) * 

1 l-XT*TEHPl 1)+YT*TENP(2) ) 

XT=RG£OM I2)/2.*SI-Y1 

RGSRS ( 2) -RGSRSI 2 )-WMI 3»L )*SIGI II+3)/2.*RGE0MI2 l*RGEOM( 5) * 

1 I -XT*T EMPI 1 )*Y1*TEMPI 2 ) ) 

IE (IND.EQ.O) GO TO 720 
XT=-RGEOMI 2 ) /2.-X1 
YT =RG£OMI l)/2.*ISI— 1. KYI 

RGSRS <3)= RGSRS 13) -WWI3»L I *SIG( 1 1 ) / 2.ARGE0H ( l ) *RGEOMI A I * 

1 ( XT* TEMP I2KYT*TEMPI1) ) 

XT =RG£OM (2I/2.-X1 
YT^RGEOMt 3)/2.*lSI-l. KYI 

RGSRSI3KRGSRSI 3 J-WWI 3 t L KSIGt I K6 ) /2.*RGE0M 13) *RGEOM( 6) * 

1 I XT*TEHP 1 2 KYT*TEMPI l) ) 

XT =RG£OM (2)/2.*SI-Yl 

RGSRS(3I=RGSRS( 3I-WMI3.L KSIG 1 1 K3 ) /2.*RGE0M 1 2 > *RGEOM( 5) * 

1 I XT*TEMP(2 KYl*T EMP ( 1 ) ) 

720 II = 11*1 

IF (SI.LE.O.O! GO TO 730 
SI = -SI 
GO TO 710 
730 CONTINUE 

T— SECT ION 

800 CONTINUE 

XI = RGE0MI2)/2.0*I RGEOM 1 2 KRGEOM 1 4 K2.0*RGEOMI 1 )*RS EOMI 3) ) / 
l I RGEOM ( 2 KRGEOM I 4 KRGEOM 1 1 KRGEOM! 3 ) ) 

DO 830 L-l » 2 
SI = AAI3.LI 

810 RGSRSI 1 ) = RGSRSI 1 1 +WWI 3»LK!SIGIIIKRGE0MI1) *RGEOMI 3KSIGIIK3)* 
l RGE0MI2KRGE0MI4) )/2.0 

YT = RGE0MI1)/2.0*SI 
XT = Xl-RGEOMI 2 ) 

RGSRSI 2 ) = RGSRSI2)-WH13.t J*SIGim/2.0*RGE0MIl)*RGE0M13I» 
l I-XT*TEMP! 1KYT*TEMP12> > 

XT=RG£OM12)/2.*ISI-I.OKX1 

RGSRS (2 ) = RGSRSI 2KWWI3»LKSIGIIK3)/2.0*RGE0MI2KRGE0M(4KXT* 

1 TEMPU) 

IF IINO.EQ.O) GO TO 820 
XT = Xl-RGEOMI 2 I 

RGSRSI 3 ) » RGSRSI 3)-WWl3«LKSIGIII ) / 2.0*RGE0MI 1 ) *RGE 0MI3 K 
1 I XT*TEMP 1 2 KYT*TEMPl II) 

XT = RGEOM(2)/2.0*ISI-1.0KX1 

RGSRSI 3 ) = RGSRS I3)-WW13*LKSIGII 1 + 3 )/2. 0*RGE0M 1 2 ) *R GE0NI4 KXT* 

1 TEMPI 2) 

820 II = II + l 

IF (SI.LE.O.O) GO TO 830 
SI * -SI 


3102330 

31023A0 


3102380 

3102400 


3102430 


3102A60 

3102A70 


3102500 


3102530 


3102570 
3102580 
3102590 
3102600 
3102610 
3102620 
3102630 
31026AO 
3102650 
3102660 
3102670 
3102680 
3102690 
3102700 
3102710 
3102720 
3102730 
3 102740 
3102750 

3102770 

3102780 

3102790 

3102800 

3102810 

3102820 

3102830 

3102840 

3102850 

3102860 

3102870 

3102880 
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non 


GO TO 810 
830 CONTINUE 
GO TO 990 

RIGHT ANGULAR SECTION 
900 CONTINUE 

X1=RGE0H(2 )/2.*(RGE0N( 2 )*RGE0M(4)+2.*RGEQH( 1 )*RGE0H( 3) )/ (RGE0H(2 ) 
1 *RGE0M(4)+RGE0M( i)*RGE0M(31) 

Y1=RGE0M( 1 )**2*RGEOM(3)/2./(RGEOM( 1 ) *RGE0M( 3 J +RGE0M( 2 > *RGE0M (4 ) ) 
DO 930 L=1 * 2 
SI = AA( 3* L ) 

910 RGSRS(l) = RGSRS ( l ) +WM (3tL)/2.0*(SIG(II )*RGE0M( 1 ) *RG E0H( 3 ) ♦ 

1 S IG( 1 1 ♦3 )*RGE0M( 2 ) *RGE0H ( 4) ) 

XT = X1-RGE0H(2) 

YT = Y l+RGEOHI 1)/2.Q*(SI-1.0) 

RGSRS (21 = RGSRS(2)-WW(3,L)*SIG( ll>*RGEOM(l)*RGEOH(3)/2.0* 

1 ( — XT*TEMP( 1 )+YT*TEHP( 2)1 

XT = X1*RGE0M( 2)/2.0*(SI-1.0) 

YT = Y1 

RGSRS ( 2 ) = RGSRS(2)-MW(3,U*SIG( 1 1 + 3 >*RGEOM( 2 >*RGEOM (4 >/2.0* 

1 (-XT*TEMP( 1)+YT*TEMP(2) ) 

IE (IND.EQ.O) GO TO 920 
XT = X1-RGE0M( 2 ) 

YT a Yl+RGE0M(l)/2.0* (SI-1.0) 

RGSRS! 3 ) » RGSRS ( 3)-NH(3«L)*SIG(II) *RGEOH( 1 )*RGEOH (3 1/2.0* 

1 ( XT*TEHP( 2 ) +YT*TENP (1)1 

XT a X1+RGE0M( 2 1/2.0* (SI-1.0) 

YT = Y1 

RGSRS (3) = RGSRS ( 3 )-HM( 3«L )*S IG( I 1+3 )*RGEOH( 2 )*RGEQM (4 )/2.0* 

1 ( XT*TEHP( 2)+YT*TEHP( 1 ) ) 

920 II = 11*1 

IF (SI.LE.O.O) GO TO 930 
SI a -SI 
GO TO 910 
'930 CONTINUE 
990 RETURN 
END 

C ROUTINE ** RGSRSE ** ABACUS UPDATEO 10/01/73 


3102890 
3102900 
3102910 
3102920 
3102930 
3 102940 
3102950 


3102990 
3103000 
3103010 
3103020 
3103030 
3 1030 AO 
3103050 
3103060 
3103070 
3103080 
3103090 
3103100 
3103110 
3103120 
3103130 
3 1031A0 
3103150 
3103160 
3103170 
3103180 
3103190 
3103200 
3103210 
3103220 
3103230 
3 103240 
3103250 
3103260 
3200000 
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o o o n o r> non 


FOR. IS RGSRSE. RGSRSE 

SUBROUTINE RGSRSE ( S IG» ENTH.REP S , E » NTYP »RGEOM,PHI ) 

COMMON /GINT/ AA ( 8. 4 1 ,WW ( 8,4 ) 

DIMENSION S IGt 1 ) » TEMPI 2 ). ENTHI 1 ) .REPS I 1 ) .RGEOMI 1 ) 

11 = 1 

PI = 3. 14159265 
ANG = PHI+ENTHI3) 

TEMPI 1 1 = COSI ANG) 

TEMPI 2 1 = SINIANGI 

GO TO IIOO, 300, 400, 600, 200, 500, 700, 800, 9001, NTYP 

SOLID RECTANGULAR SECTION 

100 DO 150 L = 1 « 2 

XT = RGEOMI 1 ) / 2.0 * AAI3.LI 
110 DO 140 LL= 1,2 

YT = RGEOMI 2 ) / 2.0 * AAI3.LLI 

120 SIGIII) = E * I ENTHI 1 i - I-XT * TEMP 1 1 1 ♦ YT * TEMPI2II * 
l ENTHI 2 I - REPSIIin 

II = mi 

IFIYT .LE.O.O) GO TO 140 
YT = -YT 
GO TO 120 
140 CONTINUE 

I F I XT .LE.O.O) GO TO 150 
XT « -XT 
GO TO 110 
150 CONTINUE 
GO TO 990 

TRIANGULAR SECTION IISOSCELES) 

200 CONTINUE 

XI = RGEOMI l)*RGEOMll)*RGEOMI 3) 

ST = RGEOM 1 2 ) / 1 2.0* RGEOM ID) 

CT = SORT 1 1 .0-ST*ST ) 

X2 = 2.0*RGE0Ml 1 ) *RGEOM I 3 ) +RGEOM I 2 )*RGE0M14) 

XI = X1*CT/X2 

X2 = -RGEOMI 1 )*CT*I RGEOM 1 1 ) *RGEOM I3)+RGE0M12 )*RGEOMI 4) ) /X2 
DO 220 L= 1 , 2 
SI = AAI3.L) 

210 CONTINUE 

YT = -RGEOMI 2)/2.0*SI 

SIGI 11*3 > = E* I ENTHI 1 )- I-XT*TEMP 1 1 )*YT*TEMP 1 2 ) )*ENTHI2 )-REPS 1 1 1+3 ) ) 
XT = IXl-X2)/2.0-IX2*Xl)/2.0*SI 
YT = RGE0MI2I/2. 0*1 1.0-SI) 

SIGIII) = E*IENTHI1)-I-XT*TEMPU)*YT*TEHPI2))*ENTHI2)-REPSIII)) 

YT = -YT 

SIGIII +6 ) = E*(£NTHI1 )- !-XT*TEMP 11)*YT*TEHPI2))*ENTHI2 )-REPS 1 1 1*6 ) ) 
II = mi 

IF ISI. LE.O.O) GO TO 220 
SI = -SI 
GO TO 210 
220 CONTINUE 
GO TO 990 

Z-SECTION 

300 DENO*RGEOMI 1 )*RGEOMI 4 I+RGEOMI 2 )*RGEOMI 5 >+RGE0MI3 )*RSE0MI6 ) 

X 1=RGE0H 1 2 )/ 2.* I RGEOM 13) *RGEOH 1 6 ) -RGEOM (1)*RGE0MI4))/0EN0 


3 200010 
3200020 
3200030 
3200040 
3200050 
3200060 
3200070 
3200080 
3200090 
3200100 
3200110 
3200120 
3200130 
3200140 
3200150 
3200160 
3200170 
3200180 
3200190 
3200200 
3200210 
3200220 
3200230 
3200240 
3200250 
3200260 
3200270 
3200280 
3200290 
3200300 
3200310 
3200320 
3200330 
3200340 
3200350 
3200360 
3200370 
3200380 
3200390 
3200400 
3200410 
3200420 

3200440 

3200450 

3200460 

3200470 

3200490 

3200500 

3200510 

3200520 

3200530 

3200540 

3200550 

3200560 

3200570 



o o o non 


Y1=(RGE0MI 1 ) **2*RGE0M( 4 1-RGEOM 1 3 )**2*RGE0M 1 6 ) ) /2./0EN0 

X2“-RGE0MI 2) /2.-X1 

X3*RGE0MI2)/2.-Xl 

00 320 L=l,2 

SI = AA I 3 , L ) 

310 YT*RGE0M( 1 )/2.*l 1.0+SI >-Yl 

SIG(in = E*(ENTHI l)-(-X2*TEMP(l) + 

1 YT * TEMPI 2 ) ) * ENTHI2) - REPSIIII) 

YT=RGE0M(2)*SI/2.-Xl 

SIGI 1 1+3 > = E*( ENTHI 1 )-(-YT*TEMP( 1)-Y1*TEMP(2> )*ENTHI2 )-RE PS ( 1 1*3 ) ) 

YT=-RGE0MI3)/2.*(1.0-SI I-Yl 

SIG(Il+6)=E*(ENTHIl)-(-X3*TEMP(l) 

1 + YT * TEMPI 2) I * ENTHI2) - REPS(II+6>) 

II = 11*1 

IF (SI .LE.0.0) GO TO 320 
SI = -SI 
GO TO 310 
320 CONTINUE 
GO TO 990 

I-SECTION 

400 X1=RGEOMI2I/2.*(RGEOH(3>*RGEOH(6)-RGEOMI 1)*RGE0M(4I) /IRGEOMl D* 

1 RGEOM 14 1 +RGE0MI 2 ) *RGE0M ( 5 ) +RGEOM I 3 I *RGEOM( 6 I ) 

X2*RGEOM( 2 I/2.-X1 
X3=-RGE0M (2I/2.-X1 
DO 430 L=l,2 
SI = AAI3.LI 

410 YT = RGEOMI 1) * SI / 2.0 

SIGlII)=E*IENTH(l)-(-X3*TEMPIl) 

1 + YT * TEMP ( 2 ) ) * ENTHI2) - REPSIIII) 

YT*RGE0M(2)*SI/2.-X1 

SIGIII+3) = E * (ENTH(l) ♦ YT * TEMP(l) * ENTHI2 ) - REPSIII+3I) 

YT = RGEOM ( 3 ) * SI / 2.0 

SIGI 1 1+6 )=E*( ENTHI 1 >-(-X2*TEMPIl) 

1 ♦ YT * TEMPI 2 ) ) * ENTHI2) - REPSIII+6)! 

II = II+l 

IF IS I .LE.0.0) GO TO 430 
SI = -SI 
GO TO 410 
430 CONTINUE 
GO TO 990 

CRRC SECTION 

500 CONTINUE 

XI * 1 2 . 0*RGEOM 1 1 ) '•RGEOM I 1 ) +P I+RGEOM 1 2 1* IRGEOMl 1 ) ♦RGEOMI 2 ) /P 1 1 )* 

1 RGEOMI 3)/ 1 (4.0*RGE0M( 1 1 +P I*RGEOM 1 2 I )*RGEOM <3 1 +2 .0*RGE0M <2 1 * 

2 RGEOMI 4 ) I 
DO 520 1=1,2 
SI = AAI3.L) 

510 XT = XI 

YT = -RGEOMI 2 ) /2 • 0*S1 

SIGI II ) = E*( ENTHI 1 )-I-XT*TEMPI 1 1 +YT*TEMP I 2 I )*ENTH(2 I-REPSII I) I 
XT = RGEOM(l)/2.0*ISI-i.O)+Xl 
YT = RGEOMI 2 1/2.0 

SIGI 11 + 3 1 =E* I ENTHI 1 I- l-XT*TEMP 1 1 1 +YT4TEMP 1 2 I I *ENTH (2 I-REPSIII+3) I 
YT = -YT 

SIGI 1 1+6 )=E*( ENTHI 1 )-l-XT*TEMP I 1 )+YT*TEMPI 2 I ) *ENTH 12 I-REPSII 1+6)1 
THT = PI/2. 0*1 i.O+SI) 

XT = Xl-RGEOMt 1 1 -RGEOM 1 2)/2.0*SIN(THT) 


3200590 


3200620 


3200670 

3200680 

3200690 

3200700 

3200710 

3200720 

3200730 

3200740 

3200750 

3200760 


3200780s 

3200790 

3200810 

3200830 

3200840 

3200860 

3200870 

3200880 

3200890 

3200900 

3200910 

3200920 

3200930 

3200940 

3200950 

3200960 

3200970 

3200980 

3200990 

3201000 

3201010 

3201020 

3201030 

3201040 ' 

3201050 

3201060 

3201080 
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3201100 

3201110 



orin ono non 


3201120 




YT a RGEOM I 2 )/2.0*C0S(THT ) 

SIG( 1 1+9 ) = E*I ENTHI 1 I— I -XT* TEMP III *YT*TEHP 12)1 *ENTH (2 I-REPSl 1 1*9 I ) 
II » 11*1 

IE (SI.LE.0.0) GO TO 520 
SI a -SI 
GO TO 510 
520 CONTINUE 
GO TOi 990 

HOLLOW RECTANGULAR SECTION 

600 X1=RGEOMUI*RG£OM12I/2.*IRGEOMI5I-RGEOMI3) I/IRGEOMIl )*IRGE0M13I 
1 +RGE0HI5) I+2.*RGE0MI2)*RGE0M14)> 

X2=RGE0MI 21/2. -XI 
X3=~RGE0M I 2 I /2.-X1 
00 620L=lt2 
SI a AAI3.LJ 

610 YT a rgEOMHI * SI / 2.0 

SIGlII) = E*lENTHIl)-l-X3*TEMRm 
1 ♦ YT * TEMPI 2 1 I * ENTHI2J - REPSIIII) 

SIGIII+6)=E*IENTHIII— I-X2*TEMPI1I 
1 ■►YT*TEHPI 2 1 ) *ENT HI 2) -REPS! 1 1+6 ) I 

YT=RGE0MI2)*SI/2.-Xl 

SIGIII + 3) * E * (ENTHI1) - I RGEOM I 1 ) * TEMPI2I / 2.0 
1 -YT*TEMPIl))*ENTHI2I-REPSIII+3n 
SIGIII+9) * E * IENTHIII - I-RGEOMtl) * TEMP 1 2 ) / 2.0 
1 -YT*TEMPI 11 )*ENTHI2l-REPSl II+9) ) 

II = II + l 

IF tSI.LE.0.0! GO TO 620 
SI = -SI 
GO TO 610 
620 CONTINUE 
GO TO 990 

CHANNEL SECTION 

700 CONTINUE 

DENOa RGEOM 1 1 1 *RGEOMI 4 I ♦RGEOM I 2 J*RGE0M! 5 I ♦RGEOM I 3 )*RGEOM 1 6) 

Yl= I RGEOM ( 1 ) **2*RGE0M I 4 ) +RGEOM I 3 l**2*RGE0Ml 6 1 1 /2. /DE NO 
X1=RGE0MI 2 1/2.* I RGEOM 1 3 )*RGEOM I 6 1 -RGEOM 1 1 1 ♦RGEOM 14 ) I /DENO 
DO 720 L=l,2 
SI a AAI3.LI 

710 YT a RGEOM! 1 1/2. 0*1 SI-1. OI+Yl 
XT=-RGE0MI2)/2.-Xl 

SIGIII) = E*IENTHIll-l-XT*TEMPll>+YT*TENP!2) )*ENTH 12 I-REPS 1 1 1 1 > 
XT=RGEOM( 2 1/2. -XI 
YT=RGEOMI 3)/2.*ISI-l. I+Yl 

SIGII 1+6 )=E*IENTHI 1 )-l-XT*TEMP III +YT*TEMP 1 2 I >*ENTHI2 I-REPSIII+6) I 
XT=RGE0MI2)/2.*SI-Y1 

SIGI 1 1 +3 1 =E* I ENTH 1 1 )-I-XT*TEMPI 1 1 +Y1*TEMPI 2 I I *E NTH I 2 I -RE PS 1 1 1*3-) I 
II a n + i 

IF ISI.LE.O.O) GO TO 720 
SI a -SI 
GO TO 710 
720 CONTINUE 
GO TO 990 

T-SECT ION 

800 CONTINUE 

XI a RGEOMI2I/2.0*! RGEOM I2)*RGE0MI4)+2. 0*RGEOM 1 1 )*RGEOM< 311/ 


3201140 

3201150 

3201160 

3201170 

3201180 

3201190 

3201200 

3201210 

3201220 


3201240 

3201250 

3201270 


3201310 

3201330 

3201350 

3201360 

3201370 

3201380 

3201390 

3201400 

3201410 

3201420 

3201430 

3201440 


3201470 

3201480 

3201490 

3201510 


3201560 

3201570 

3201580 

3201590 

3201600 

3201610 

3201620 

3201630 

3201640 

3201650 

3201660 
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u u o 


1 (RGE0M(2)*RGE0M(4)*RGE0M( 1)*RGE0M<3>> 

DO 820 L = l,2 
SI a AA(3,L) 

810 XT » Xl-RGEOH 1 2 ) 

YT a RGEOMt 1 )/ 2.0*S I 

SIG(II) = E*(ENTH(ll-(— XT*TEMP(1)*YT*TEMP(2) )*ENTH(2 )— REPS (II)) 

XT * RGE0M2 1/2 .0*1 S 1-1 .0 l+X 1 

SIG(II*3)=E*(ENTH(1 )*XT*TEHP( 1)*ENTH(2)-REPS(II*3) ) 

II * 11*1 

IF (SI.LE.O.O) GO TO 820 
SI a -SI 
GO TO 810 
820 CONTINUE 
GO TO 990 

RIGHT ANGULAR SECTION 
900 CONTINUE 

X1=RGEOM(2)/2.*<RGEOM<2)*RGEOM<4>+2.*RGEOM( I )*RGEOM( 3) )/ <RGE0M<2) 
1 *RGE0M(4)+RGE0M(1)*RGE0M{3)) 

Yi*RGEON( l ) **2*RGE0N( 3)/2./(RGEON(l)*RGEON(3 )+RGEOM( 2 ) *RGE0M(4 ) ) 
DO 920 L*l,2 
SI a AAI3.LI 

910 XT a X l-RGEOMI 2 ) - • ■ 

YT a RGEOM ( 2 )/2 .0*1 SI— 1.0I+Y1 

SIGIIII = E*< ENTH( D— I— XT*TEHP(1)+YT*TEMP(2))*ENTH(2 )-REPSiim 
XT a RGEOM ( 2)/2.0*(SI— 1.0)*X1 
YT a y 1 

SIG(II*3)aE*<ENTH(l)-(-XT4TENP(lKYT*TEHP(2) >*ENTHI2 )-REPS(II*3) ) 
II a n*i 

IF (SI.LE.O.O) GO TO 920 
SI a -SI 
GO TO 910 
920 CONTINUE 
GO TO 990 
990 RETURN 
END 


3201670 

3201680 

3201690 

3201700 

3201710 

3201720 

3201730 

3201750 

3201760 

3201770 

3201780 

3201790 

3201800 

3201810 

3201820 

3201830 

3201840 


3201880 

3201890 

3201900 

3201910 

3201920 

3201930 

3201940 

3201960 

3201970 

3201980 

3201990 

3202000 

3202010 

3202020 

3202030 
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SUBROUTINE STRMAT 

) 

The region stiffness matrices, XKR, and the region load matrices, XLR, 
are passed from REGMAT to STRMAT via Tape jfh and Tape #8, and are placed 
in the XKSTOT array and the XISTOT array, respectively. A matrix, BCD, 
is formed to represent the boundary conditions, and, if kinematic links 
occur between regions, the RKL matrix is developed to represent this 
situation. The subroutine RINGER is again called for discrete ring 
matrices. 

As a result of appropriate matrix operations, a reduced structure stiffness 
matrix is formed. The solution of the ^problem is obtained by again calling 
the routine SYMSOC . - This produces the region end deflection array, DRE. 
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FORTRAN CODE 

ENGiREERINO SYMBOLS (REF. l) 

BCD MATRIX 

M 

BCT MATRIX 

[bc) t 

XST MATRIX 

Wt 

XKF MATRIX 

Mr 

A MATRIX 

Mr 

XSL MATRIX 

iV 

XLS ARRAY 

Mr 

XFL ARRAY 

A 

W r - 

DRE ARRAY 

Mt 


t 

■X 
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STRMAT 


READ NOJ. 

NORING, 

NLINK 

1 

r 

form 

XSTM 

ATRIX 

— 






CALL 

^ / NLINK \ YES ^ 

FORM 

RINGER 

i 

r r \ = y a 


BCD MATRIX 









NO 


YE S 


< w 

1 

r 

BCT = 
IRKL] 

(BCD) 


f 

RENAME 

BCD 

BCT 


FORM 


FORM 

XKF MATRIX 


FORM 

XSL ARRAY 



BCT = (BCD) 7 


iL 


M 


FORM 

XLS ARRAY 


FORM 
W XFL MATRIX 


RESET 
(XLS) = 

[XFL] - (XLS) 


CALL 

SYMSOC 

w 





( RETURN TO 
MAIN 


WRITE 
NO. 3 
DRE 
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FOR, IS STRMAT .STRMAT 

SUBROUTINE STRMAT 

INTEGER SAVJTC.SAVSTP.Q, THICK 

INTEGER XN1,XN 

COMMON S TORY < 16 >,XMATI 270,10) , STD ( 10) , SADUS 1 30 ) .RADUS 1 30 ) 

COMMON T AOUS ( 30 J , UAOUS < 30 ) • SAVT IC ( 900 ) 

COMMON XN, TEFREE, TIC, PHI, STOP, RESTOP, RTICK,G1,XNL(3) ,NH 
COMMON NST(30),NKL(30),NXMAT(20),SAVJTC(30)« SAVSTP (30 ) • JRTICI30) 
COMMON JRST0PC30) ,NREG, NMPT ,NRC,NSC, NIX, IERROR.KGEOM , IGEOM, I STTAB 
COMMON KELVIN, IBEGIN.NPROB, NSEG.NERROR ,Q , THICK, NOJS. NLl NKS.NLCASE 
COMMON NTSKL,NZ,NBCT,L INPUT, NTRKL ,NPASS, XN1 ,KBC .NRINGS 
COMMON LODE, ICYCLE, LO ISTL 

COMMON /ARING/ NR ING( 28 ) , AMAT( 30, 8 ) , RSIGI 12 ) .REPSI12 ) .RALPH (12), 

C RBAPHI12) 

COMMON /PLS/ OMEGA, IWORD , XMERD , XPRES , XMONT 
COMMON /CDISP/ P,PMAX,0ELP,0ELP1,YEPS,ZEPS 
DIMENSION SCLA( 128) , LOCI 128) 

DIMENSION ICOL(IO) 

DIMENSION RKLI120,120),0PEN<4,4) 

DIMENSION DCP(4),8CD( 124, 124) , TEMPI 124) ,BCTI 124) ,XKF (128) ,8C(128) 
DIMENSION A( 124, 124 ) , XSL ( 124, 1 ) , XFL ( 124, 1 ) ,DRE ( 128 ,1 ) ,BC A( 128 ) 
DIMENSION XKR(8,8 ),XSTR( 128 ),XLS( 124, 1 ) ,XLR( 8, 1 ) 

DIMENSION XST(124,1 24 ),XSTBC(124, 124), TEMP 1(124) 

DIMENSION RNGTOT ( 4, 4 ) .RNGLOO t 4,28 ) , JTNO ( 28) 

DIMENSION COLTTL ( 2 1 
DIMENSION LEAD! 1 ) 

EQUIVALENCE ( XST ( 1 ) , BCD! 1 ) , A( 1 ) , XSTBC ( 1 ) »RKL ( 1 ) ) 

EQUIVALENCE ( XSTR (1) , XKF ( 1 ) ,XFL ( 1 ) , XSL ( 1 ) ,DRE ( 1 > , SCL A ( 1 ) , 

1 TEMPI 1 ), OPEN! 1 ) ) 

EQUIVALENCE (XKR ( 1 ) , XLR ( 1 ) , BC ( 1 ) ,BCT ( 1 ) ,BCA (1) , TEMPI ( 1 ) , LOC ( 1 ) ) 
DATA C0LTTL/4H CO, 4HLUMN/ 

REWIND 2 
REWIND 3 
REWIND 4 
REWIND 8 
REWIND 9 
REWIND 14 

1 FORMAT ( 1H ,8<E14.7,2X)/( 3X, 8( E 14. 7, 2X ) ) ) 

101 FORMAT (3I5.16A4) 

IF (NH.E0.0.0R.I8EGIN.EQ.1) WRITEI6, 1726) 

1726 FORMAT ( 1H1 ) 

IF (NH.NE.O) GO TO 1700 

READ! 5, 101) NOJ, NORING, NLINK 

NOJS = NOJ 

NL INKS = NL INK 

NRINGS = NORING 

GO TO 1701 

1700 NOJ = NOJS 

NL INK = NLINKS 
NORING = NRINGS 

1701 CONTINUE 
NH4=4 
NH8=8 

NJTNH4=N0J*NH4 
DO 102 J = l» NJTNH4 
DO 102 1=1, NJTNH4 

102 XST(I,J)=0.0 

DO 100 NR=1, NREG 

RE ADI 4 ) l(XKR(I,J),J=l«8),l=l,8) 

J1 = JRT I C I NR ) 

J2=JRST0P( NR ) 

1 1 =4*1 J 1— 1 ) 


1600010 

1600020 

1600030 

1600040 

1600050 

1600060 

1600070 

1600080 

1600090 

1600100 

1600110 

1600120 

1600130 

1600140 

1600150 

1600160 

1600170 

1600180 

1600190 

1600200 

1600210 

1600220 

1600230 

1600240 

16002S0 

1600260 

1600270 

1600280 

1600290 

1600300 

1600310 

1600320 

1600330 

1600340 

1600350 

1600360 

1600370 

1600380 

1600390 

1600400 

1600410 

1600420 

1600430 

1600440 

1600450 

1600460 

1600470 

1600480 

1600490 

1600500 

1600510 

1600520 

1600530 

1600540 

1600550 

1600560 

1600570 

1600580 

1600590 

1600600 

1600610 
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490 

JJ-4*IJ2-l)*l 

1600620 


II*IH1 

1600630 


DO 460 JK- It 4 

1600640 


GO TO 1451*452*453*4541 »JK 

1600650 

451 

IX-II 

1600660 


I NO* I I 

1600670 


DO 461 1-1*4 

1600680 


DO 461 J-l *4 

1600690 

461 

OPEN! I » J l-XKRI I* J ) 

1600700 


GO TO 455 

1600710 

452 

IX-II 

1600720 


IND-JJ 

1600730 


DO 462 1-1*4 

1600740 


00 462 J*1,A 

1600750 

462 

OPEN! I »J l-XKRI I * J+4 I 

1600760 


GO TO 455 

1600770 

453 

IX-JJ 

1600780 


I NO- I I 

1600790 


DO 463 1-1*4 

1600800 


DO 463 4-1*4 

1600810 

463 

OPENI I * J l-XKRI 1+4* J ) 

1600820 


GO TO 455 

1600830 

454 

IX-JJ 

1600840 


IND-JJ 

1600850 


DO 464 1-1*4 

1600860 


DO 464 J-l, 4 

1600870 

464 

OPENI I *J l-XKRI I+4*J+4) 

1600880 

455 

DO 456 1-1,4 

1600890 


JX-IND 

1600900 


DO 457 J-l, 4 

1600910 


XSTIIX,JX)-XSTt IX,JX)+OPEN(I,J) 

1600920 

457 

JX-JX+1 

1600930 

456 

IX-IX+l 

1600940 

460 

CONTINUE 

1600950 

100 

CONTINUE 

1600960 


IF INORING.EQ.OI GO TO 1170 

1600970 


MFLG - 2 

1600980 


DO 1211 J-l* NORING 

1600990 


CALL RINGER (Q, XN,RN6T0T,RNGL0D* J*SAOUS*UADUS* JRTIC* JRSTOP* JTNO, 

1601000 


KBC*XNL,HFLG*NREG* 1 CYCLE* IBEGIN,LDISTL) 

1601010 


JT - 4*1 JTNO(J)-l) 

1601020 


DO 1220 1-1*4. 

1601030 


00 1220 IK-1,4 

1601040 

1220 

XSTIJT+I»JT+IK) • XSTI JT+I* JT+1K l+RNGTOTt I, IK I 

1601050 

1211 

CONTINUE 

1601060 


IF (Q.NE.5) GO TO 1170 

1601070 


MRITEI6.300) 

1601080 

300 

FORMAT I///) 

1601090 


READ! 5* 20001 

1601100 

2000 

FORMATS IX) 

1601110 

1170 

CONTINUE 

1601120 


00 107 I-1,NJTNN4 

1601130 

107 

WRITE (2) I XST 1 1 * J )* J-l ,NJTNH4I 

1601140 


REWIND 2 

1601150 


REWIND 4 

1601160 


IF INH.NE.O) GO TO 3200 

1601170 

C GENERATION OF BC BOUNDARY CONDITION SCRABBLING NATRIX 

1601180 


WR ITEI 6, 347 ) NOJ.NL INK 

1601190 

347 

FORMAT ( / ///5 1X30H INPUT OATA FOR REGION C0UPLING///31 X24HNUMBER OF 

1601200 

1REGI0N JOINTS * 13* 14X26HNUHBER OF KINENATIC LINKS t I 3///44X6HREGI0 

1601210 

2N1 1X8HJ0 INT ( I ) 1 1X8HJ0 INTI J ) // ) 

1601220 
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DO 348 1 = 1* NREG 
KT IC= JRT IC ( I > 

,KSTOP= JRSTOP ( I ) 

WR ITE 16 , 349 ) I,KTIC,KSTOP 
349 FORMAT 1 46X , I 2, 2 ( 16X , 1 3 ) ) 

348 CONTINUE 

IFINLINK .EQ.O) GO TO 3108 
DO 756 1 = 1* NJTNH4 
DO 756 J= 1 * NJT NH4 

756 RKL < I * J ) =0 .0 

DO 757 I = 1.NJTNH4 

757 RK L I I • I > =1.0 
DO 789 1=1,4 

DO 789 J=i,4 
789 OPEN ( ( * J ) =0. 0 
OPEN (2,2) = 1.0 
OPEN! 3 , 3 J = 1.0 
OPEN! 4,4 ) =1.0 
WRITEI6, 1824) 

1824 FORMAT ( //60X , 12HREG ION L INKS//43X, 8HJ0INT( J ) , 5X ,'8H JO INTI I ) , 
1 5X , 20HANGLE OF ORIENTATION) 

DO 502 NR I G= 1, NL INK 
READ! 5,503 ) JD,JI, COTAN 
503 FORMAT (2I2,E14.7) 

WRITEI6, 1828) JD.JI, COTAN 

1828 F0RMAT(46X,I2,11X,I2,11X,E14.7) ' ' 


1829 


1830 


505 

504 

502 


781 

3108 


108 


2372 

1HDELTA Z,5X,7H0ELTA R, 5X,7H, THETA , 7X,.l 1HANGLE . fLPHA > 

do 109 j= i , noj •••,' ' ) ■ 

READ (5,110) JN, DLP ( l ) * DLP ( 2 ) * OLP ( 3 ) »DLP ( 4.) , ANGLE ,, ... 

110 FORMAT ( I2,4F2.0,E14.l) 

11 = OLP(l) 

12 = DLP ( 2 ) 


IF (SIN(COTAN).NE.O.O) GO TO 1829 
OPEN (1,1) = 1.0 

OPEN! 2,4) = 0.0 ... f 

OPEN( 3,4 ) =0.0 

GO TO 1830 
CONTINUE 

COTAN = COS ( CO TAN )/ SIN< CO TAN) 

OPEN! 1,1) = SADUS(JO) / SAOUS(JI) 

0PENI2.4 ) = - (SADUS(JD)-SADUS(JI)) 

OPEN! 3,4 ) = - OPEN( 2, 4)* COTAN 

CONTINUE , 

.IX X« JD*4-3 ' . , ! 

DO 504 1=1,4 
JXX= J I *4-3 
DO 505 J=1 ,4 

RKL( I XX , JXX )=OPEN ( I , J ) . . , 

JXX=JXX*l ’ ' ' '• v 

IXX=IXX*1 

CONTINUE ' 

READ! 5,2000 ) 

DO 781 1=1, NJTNH4 

WRITEI3) ( RKL ( I,J),J=1,NJTNH4) 

REWIND 3 
CONTINUE 

DO 108 J=1 , NJTNH4 
DO 108 I=1,NJTNH4 
BCD! I , J ) =0.0 

ICR =1 v ‘ 

WRITE(6,2372) . . . . . - .'i.. 

FORMAT! //////57X19HB0UNDARY CONDITIONS// 30 X5H40INT5X7HDELTA 


1601230 
1601240 
1601250 
1601260 
1601270 
1601280 
. 1601290 
11101300 
160.1310 
1601320 
1601330 
1601340 
1601350 
, , . 1601360 

1601370 
1601380 
1601390 
1601400 
1601410 
1601420 
1601430 
1601440 
1601450 
1601460 
1601470 
' 1601480 
1601490 
1601500 
' 1601510 
1601520 
1601530 
1601540 
1601550 
; . 1601560 

.1601570 
1601580 
1601590 
1601600 
1601610 
1601620 
1601630 
.1601640 
1601650 
. 1601660 
1601670 
1601680 
1601690 
1601700 
1601710 
1601720 
1601730 
1601740 
1601750 
1601760 
1601770 
T.»5X»7 1601780 
. 1601790 

1601800 
1601810 
1601820 
1601830 
1601840 
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2373 


115 

114 


116 


117 

118 
113 
121 
109 


782 

783 


126 

C 

3124 

124 

125 


3200 
3300 

3201 


181 

184 


180 


183 


13 = DLP 1 3 ) 


1601850 

14 = DLP (41 


1601860 

WRITE (6. 2373) JN, 11, 12, 13, 14, ANGLE 


1601870 

FORMAT </3 IX, 13, 9X, 12, 10X, 12, 10X, 12, 10X, 12, 

7X,E 14. 7) 

1601880 

II = <4*JN)-3 


1601890 

00 121 1=1,4 


1601900 

IF IDLPI I 1—1-0* 113,114,115 


1601910 

IFIDLPID-2.0) 116,116,117 


1601920 

BCD! II, ICR 1 = 1.0 


1601930 

GOTO 118 


1601940 

BCD! II, ICR)=SIN( ANGLE) 


1601950 

BCD! I I + i , ICR )= -COS(ANGLE) 


1601960 

GOTO 118 


1601970 

BCDI II-l, ICR )=COS( ANGLE) 


1601980 

BCOIII, ICR )=SINt ANGLE) 


1601990 

ICR= ICR+ 1 


1602000 

11=11+1 


1602010 

CONTINUE 


1602020 

CONTINUE 


1602030 

RE AD ( 5 , 2000 ) 


1602040 

ICR=ICR-1 


1602050 

NZ=ICR 


1602060 

IF (NLINK.EQ.O) GO TO 3124 


1602070 

DO 783 N= 1 , NJTNH4 


1602080 

.RE ADI 3 ) ITEMP(M),M=1,NJTNH4) 


1602090 

DO 782 J=1 ,NZ 


1602100 

BCT ( J ) *0 .0 


1602110 

DO 782 I=1,NJTNH4 


1602120 

BCT(J)=BCTIJ)+TEMP(I) *BCD( I , J ) 


1602130 

WRITE 14) I BCT ( L ) , L=1 , NZ ) 


1602140 

REWIND 3 


1602150 

REWIND 4 


1602160 

DO 126 M=1,NJTNH4 


1602170 

READ! 4) (8CD(M,N),N=1,NZ) 


1602180 

AT THIS POINT THE BCO ARRAY IS THE PRODUCT 

OF RKL AND BCD ARRAYS 

1602190 

CONTINUE 


1602200 

DO 124 J=1 ,NZ 


1602210 

WRITEI14) (BCDI I , J) , 1=1 , NJTNH4 1 


1602220 

DO 125 1=1, NJTNH4 


1602230 

WRITE! 14) (BCDI I,J),J=1,NZ) 


1602240 

REWIND 14 


1602250 

REWIND 4 


1602260 

GO TO 3201 


1602270 

DO 3300 J= 1, NZ 


1602280 

READ! 14 ) I BCDI I , J ), I=1,NJTNH4 ) 


1602290 

REWIND 14 


1602300 

CONTINUE 


1602310 

DO 180 L= 1 , NJTNH4 


1602320 

READ (2) I XSTRI J ) ,J = 1,NJTNH4) 


1602330 

DO 184 M=1,NZ 


1602340 

TEMPI I M) = 0.0 


1602350 

00 181 N= 1 , NJTNH4 


1602360 

TEMPI I M ) = TEMPl(M)+XSTR(N)*BCD(N,M) 


1602370 

CONTINUE 


1602380 

WRITEI4) (TEMPI! I I, 1=1, NZ) 


1602390 

CONTINUE 


1602400 

REWIND 4 


1602410 

DO 183 11=1 ,NJTNH4 


1602420 

READ (4) (XSTBCI II,JJ),JJ = 1,NZ) 


1602430 

REWIND 4 


1602440 

DO 182 N= 1 , NZ 


1602450 


\ 
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RE ADI 14 ) ( BCT ( J I » J* 1*NJTNHA ) 

DO 185 M=1»NZ 

XKF ( M)=0 .0 

DO 186 K= 1 » NJTNHA 

186 XKF(M)=XKF(M)+BCT(K J*XST8C(K,MI 
185 CONTINUE 

WRITE (A) ( XKF ( I ) » 1 = 1»NZ ) 

182 CONTINUE 
REWIND 2 
REWINO A 
DO 187 1=1, NZ 

187 READ! A ) (A( I,J), J=1,NZ) 

IF ( IBEGIN.EQ.O.OR.LINPUT.EQ.O) GO TO 1750 
WR ITEI 6,1726) 

WR ITE ( 6, 2365 ) 

2365 FORMAT ( 50X.29H THE REDUCED STIFFNESS MATRIX/) 
NUMBER = 2 
JJ = 0 
JJJ = 0 

1725 JJ « JJJ + 1 
JJJ = JJJ ♦ 8 
MM = 8 

IF IJJJ.GT.NZ) MM*8-( JJJ-NZ) 

MMM * JJ 

IFIJJJ.GT.NZ ) JJJ=NZ 
DO 1721 M=l, MM 
I COL( M )=MMM 

1721 MMM = MMM ♦ 1 
NUMBER = NUMBER ♦ 3 

WRITE (6, 17291 ( ( CQLTTL, ICOL (M ) ) ,M=1, MM ) 

1729 FORMAT ( / 10H ROW , 8( 2AA, IX, 1 3 , 3X ) / ) 

DO 1722 1=1, NZ 

NUMBER = NUMBER + 1 

WRITE (6, 1728)1, (A< I, J),J=JJ, JJJ) 

1728 FORMAT ( 3X, I3*AX,8(E1A.7* IX) ) 

IF (NUMBER.LT. 55) GO TO 1722 
NUMBER = 3 
WR ITE ( 6, 1726 ) 

WRITE (6, 1729) ( ( COLTTL , ICOL (M ) ),M=1,MM) 

1722 CONTINUE 

IF ( JJJ . NE .NZ ) GO TO 1725 
1750 CONTINUE 
REWIND 1A 
DO 991 J = 1 » NPROB 
DO 991 1*1, NJTNHA 
991 XSL(I.J) = 0.0 
1001 DO 777 NR* 1, NREG 
J1 = JRTIC(NR) 

J2 = JRSTOP(NR) 

RE ADI 8 ) ( (XLR( I, J), J=l, NPROB), 1 = 1, NHB) 

DO 777 N2 = 1,2 
GOTO ( 1 1 , 12 ) ,N2 

11 II = ( Jl-i )*NHA*1 
III* II+NHA-1 
GOTO 3 

12 II = <J2-l)*A*l 
III* II+NHA-1 

3 DO 777 J=l, NPROB 
1 = 0 

IFIN2.EQ.2) I*NHA 
DO 777 IL*I I • 1 1 1 
I * I ♦! 


1602A60 

1602A70 

1602A80 

1602A90 

1602500 

1602510 

1602520 

1602530 

16025A0 

1602550 

1602560 

1602570 

1602580 

1602590 

1602600 

1602610 

1602620 

1602630 

16026AO 

1602650 

1602660 

1602670 

1602680 

1602690 

1602700 

1602710 

1602720 

1602730 

16027A0 

1602750 

1602760 

1602770 

1602780 

1602790 

1602800 

1602810 

1602820 

1602830 

16026A0 

1602850 

1602860 

1602870 

1602880 

1602890 

1602900 

1602910 

1602920 

1602930 

16029A0 

1602950 

1602960 

1602970 

1602980 

1602990 

1603000 

1603010 

1603020 

1603030 

16030A0 

1603050 

1603060 

1603070 
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777 XSL!IL,J) = XSL( IL, JJ+XLR! I,J) 

IF ( NORING. EQ.O) GO TO 1150 
00 1225 J=1*N0RING 
JT = 4*( JTN0!J)-1I 
00 1227 1=1,4 
DO 1226 IK=1,NPR0B 

1226 XSL! JT+l » IK ) = XSL( JT + I , IK I ♦RNGLOD! I , J I 

1227 CONTINUE 
1225 CONTINUE 
1150 CONTINUE 

00 876 N* 1 »NZ 

READ! 14 ) I 8CT ! J ) * J= 1* NJTNH4 ) 

00 717 M = 1 * NPROB 
XLS(N.M) » 0.0 
DO 806 K*1,NJTNH4 

806 XLSIN.H) = XLS(N.M) ♦ BCTIK )* XSL ! K»M ) 

717 CONTINUE 
876 CONTINUE 

00 301 J=l, NPROB 
DO 301 1=1, NZ 

301 XFL ( I , J ) = 0.0 

IF (LDISTL.EQ. 1 ) GO TO 360 

RE AOI 5, 302 ) L INLOO ,( STORY ( 11,1 = 1,16) 

302 FORMAT! I4.16A4) 

WRITE! LOOE ) LINLOO 
GO TO 361 

360 READ1L0DE) LINLOD 

361 CONTINUE 

IF(LINLOD.EQ.O) GO TO 303 
IF (ICYCLE.EO.l.OR.NH.EQ.O) WRITE!6,341> 

341 FORMAT! 1H1///57X, 19HEXTERNAL LINE L0A0S///36X, 14H PROBLEM 
120HPOINT OF APPLICATION, 7X, 12HAPPL IED LOAD//) 

IF (LOI STL.EQ. 1 ) GO TO 362 

JEXT2 = 1 

DO 304 N=l, LINLOO 

READ! 5,305) JEXT1 ,XFL ! JEXTl , JEXT2 ) 

305 F0RMAT!5X,I5,E14.7) 

IF (ICYCLE.EQ.l.OR.IBEGIN.EQ.l) 

1WR ITE ( 6, 342 ) JEXT2, JEXTl , XFL < JEXTl , JEXT2 ) 

342 F0RMAT!41X,I3,22X,I3,15X,E14.7) 

304 CONTINUE 

WR ITE ! LOOE ) 1! XFL < I , J > , 1 = 1 ,NZ J , J = l .NPROB ) 

GO TO 303 

362 RE AO ! LOOE ) ( ! XFL ( I , J ) , 1= 1,NZ ) , J= 1 , NPROB ) 

303 CONTINUE 

IF (LOISTL.NE.l) REA015.2000) 

306 CONTINUE 

00 811 J*l, NPROB 
00 811 1=1, NZ 

811 XLS1I.J) = XFL! I » J )*OELP-XLSl I»J) 

00 520 J=l, NPROB 
DO 530 1*1, NZ 

IF (XLSll.J).NE.O.O) GO TO 540 
530 CONTINUE 

LEAD! J ) = NZ 
GO TO 520 
540 LE AO! J ) = I 
520 CONTINUE 

CALL SYMSOC ( A, A ,NZ ,0 ,XLS, NPROB, LEAD, 124,0. 0,NI X ) 

IF ! N IX .NE .0 ) GO TO 8777 
DO 812 J* 1 , NJTNH4 


1603080 
1603090 
1603100 
1603110 
1603120 
1603130 
1603140 
1603150 
1603160 
1603170 
1603180 
1603190 
1603200 
1603210 
1603220 
1603230 
1603240 
1603250 
1603260 
1603270 
1603280 
1603290 
1603300 
1603310 
1603320 
1603330 
1603340 
1603350 
1603360 
1603370 
NUMBER, 7X 1603380 
1603390 
1603400 
1603410 
1603420 
1603430 
1603440 
1603450 
1603460 
1603470 
1603480 
1603490 
1603500 
1603510 
1603520 
1603530 
1603540 
1603550 
1603560 
1603570 
1603580 
1603590 
1603600 
1603610 
1603620 
1603630 
1603640 
1603650 
1603660 
1603670 
1603680 
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RE ADI 14 ) I BC I K ) , K=1,NZ I 
DO 813 M= l , NPROB 
DRE I J, M) =0.0 
DO 813 N=1,NZ 

813 DRE(J,M) = ORE! J ,M) *8C I N )*XLS I N,M) 

812 CONTINUE 

IF I NH.NE .0. AND. (LI NPUT.NE.l. OR.IBEGIN.NE.il ) GO TO 1776 
WRITEI6.1726) 

WRITE! 6*2368 ) 

2368 F0RMATI31X.70HTHE EXPANOEO REGION JOINT DISPLACEMENT MATRIX (REG 10 
IN END DEFLECTIONS)) 

WR ITE ( 6 * 1770 ) 

1770 FORMAT < // 14X , 5HJ0 INT « 14X » 7HPR0BLEM, 13X , 7HDEL TA T ,13X .7HDELTA 2,13X 
1 « 7HDELT A R , 1 IX, 1 1H0MEGA-THETA ) 

NUMBER = 4 
KK=-3 

DO 1735 J=1,N0J 
NUMBER = NUMBER ♦ NPROB ♦ 1 
IFINUMBER.LT. 56) GO TO 1745 
WR ITE ( 6, 1726) 

WRITE (6, 1770) 

NUMBER=2*NPR0B+3 
1745 KK=KK+4 
KKK=KK*3 
WR ITE ( 6, 1739) 

1739 FORMAT! 1H I 

DO 1764 L*1 , NPROB 

WRITE 16, 1765) J,L,(DRE(K,L) ,K=KK,KKK ) 

1765 FORMAT ( 15X, I 2, 18X, I 2, 9X, 4( 3X, E 14. 7, 3X) ) 

1764 CONTINUE 
1735 CONTINUE 
1776 CONTINUE 

UO 71 NR= 1 , NREG 
DO 71 K = 1,2 

II = I JRT IC I NR ) - 1) *4 *1 
IFIK.EQ.2) 11= JRSTOPINR 1 ♦4—3 
1 1 1= II ♦ 3 
DO 71 I = II, III 

71 WR ITE I 3 ) (DRE(I,J),J = 1, NPROB) 

REWIND 2 
REWIND 3 
REWIND 4 
GOTO 7 

8777 IERROR =8777 
NERR0R=32 
NIX=1 
7 RETURN 
END 
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SUBROUTINE INIIAL 


As a result of the matrix operations performed in REGMAT, the SKI22, the 
XK2221, and the XK22L2 arrays for each region are passed to INITAL. The 
XK1112 and XL1 arrays for each segment, resulting from the matrix procedures 
in SEGMAT, are also passed to INITAL. The region end deflection matrices, 
DRE, which were formed in STRMAT are transmitted to INITAL. 

Following appropriate matrix operations upon these arrays, the force initial 
conditions, the FICS array, and the deflections initial conditions, the 
DICS array, are produced. These arrays combine to form the YICS matrix, 
which contains the true initial conditions for the structure to be 
analyzed. 

The pertinent counters in the subroutine are: 

NS = segment counter 
NR « region counter 
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FORTRAN CODE 


XK2221 MATRIX 


ENGINEERING SYMBOLS (REF. 1 


w 1 w 


) 


XK22L2 MATRIX 

DSE ARRAY 
XK1112 MATRIX 



ROTD MATRIX 
DICS ARRAY 
XL1 ARRAY 

ROT MATRIX 
FICS ARRAY 


U(i)| 

[iF-rf 
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FOR, IS INITAL, INITAL 

SUBROUTINE INITAL 

INTEGER SAVJTC, S AVS TP »Q, THICK 

INTEGER XNl.XN 

COMMON St ORY ( 16 > , XMAT < 270, 10 > , STD< 10 * , SADUS ( 30 1 ,RADU SC 30 ) 

COMMON T AOUS 1 30 ) « UADUSI 30 ) , SAVTIC ( 900 1 

COMMON XN,TEFREE,TIC,PHI,ST0P,REST0P,RTICK,G1,XNL(3) ,NH 
COMMON NST(30)«NKL(30),NXMAT(20),SAVJTC(30),SAVSTP(30) ,JRTIC(30) 
COMMON JRSTQPI30) ,NREG, NMPT,NRC,NSC ,NI X , IERROR ,KGEOM , IGEOM, I STTAB 
COMMON KELVIN, IBEGIN,NPROB,NSEG,NERROR,Q, THICK, NOJS, NL INKS ,NLCASE 
COMMON NTSKL ,NZ ,NBCT,L INPUT, NTRKL ,NP ASS, XN1 ,KBC, NR INGS 
COMMON LOOE, ICVCLE, LO ISTL 

DIMENSION XK2221I 112, 8) , ORE I 8, 1 ) , TEMPI112, 1 > .XK22L2I 112,1) 
DIMENSION XK1112(4,8),DSE(8,1),R0TD(4,4),0ICS(4,1) 

DIMENSION TQSE(8,1),YICS(8,1) 

DIMENSION XL 1(4, 1 ) , ROT( 4, 4 ) ,F ICSI 4, 1 > , SKL22 < 112 , 112) , ANSI 112,1) 
EQUIVALENCE (ROTI 1 ) ,ROTO( 1 )),( TIC, TICK) 

EQUIVALENCE ( DSE ( 1 ) , OREI 1 ) ) , ( XK2221I 1 ) , XK22L2I1) ) 

EQUIVALENCE (SKL22( 1), XK 1112(D), (YICSI1 )., TO SE 11)1 
NH4 = 4 
NH41*NH4*1 
NH8 = 8 
NH81=NH8*1 
REMIND 2 
REMIND 3 
REMIND 4 
REMIND 8 
REMIND 9 
REMIND 10 
DO 100 NR*l *NREG 
NOJ = NST(NR) ♦ NKL(NR) ♦ 1 
ISKL22 = 4* ( NOJ-2 ) 

JSKL22 * 4*( N0J-2-NKL ( NR ) ) 

NJTNH4=N0J*NH4 
M8=4* ( NOJ-NKLI NR ) )— 8 
NSEG=NST ( NR ) 

IF (NSEG.EQ.l) GOTO 703 
IFINKL(NR).EQ.O) GO TO 415 

RE ADI 10 ) ( ( SKL22I I , J ) , J= 1 , JSKL22 ) , 1 = 1, I SKL22 ) 

415 RE AD ( 10 ) ( (XK2221I I, J), J=1,NH8>, 1=1, M8) 

READ(IO) (SAVJTC! I ) , S AVSTP (I) , I=1,NSEG ) 

703 DO 91 K = 1,2 

II = 1 

IFIK.EQ.2) 11=5 

III = 11*3 

DO 91 I=II,III 

91 RE AD l 3 ) ( ORE ( I , J ) ,J=1,NPR0B ) 

IF (NSEG.EQ.l) GOTO 999 
DO 101 J= 1 , NPROB 
DO 101 1*1, M8 
TEMPI I , J )=0.0 
DO 101 K=1,NH8 

TEMPI I, J) = TEMP( I,J)+XK2221( I , K )*DRE ( K, J ) 

101 CONTINUE 

READ! 10 H (XK22L2I I, J ) , J= 1 , NPROB ) , I* l ,M8 ) 

DO 102 J=l, NPROB 
DO 102 1=1, M8 

102 TEMPI I , J ) = -(TEMPII, J) + XK22L2(I, J) ) 

IF(NKLINR).EQ.O) GO TO 435 

DO 445 I = 1 , ISKL 22 


1700010 
1700020 
1700030 
1 7000.40 
1700050 
1700060 
1700070 
1 700080 
1700090 
1700100 
1700110 
1700120 
1700130 
1700140 
1700150 
1700160 
1700170 
1700180 
1700190 
1700200 
1700210 
1700220 
1700230 
1700240 
1700250 
1700260 
1700270 
1700280 
1700290 
1700300 
1700310 
1700320 
1700330 
1700340 
1700350 
1700360 
1700370 
1700380 
1700390 
1700400 
1700410 
1700420 
1700430 
1700440 
1700450 
1700460 
1700470 
1700480 
1700490 
1700500 
1700510 
1700520 
1700530 
1700540 
1700550 
1700560 
1700570 
1700580 
1700590 


125 



DO 445 J = l » NPROB 
ANSI I, J)=0.0 
DO 445 K = 1.JSKL22 

445 ANSI I« J) -ANSI It JI+SKL221 I ,K )*TEMPI K , J I 
435 DO 391 N*1,N5EG 

IF((N.EQ.1.0R.N.EQ.NSEG).AND.SAVJTCIN).GT.SAVSTP(N)) GO TO 370 
00 398 K=l,2 

IF (N.NE.l.OR.K.NE.l) GOTO 393 
DO 394 1= 1,4 

394 WRITE (2) IDREl I , J » , J*'l , NPROB » 

GO TO 398 

393 IFIN.EQ.NSEG.AND.K.EQ.2) GOTO 395 
IF IK.EQ.l) II = SAVJTC I N ) *4-7 
IF IK.EQ.2) II = SAVSTPI N 1*4-7 
III = II ♦ 3 
DO 397.1=11,111 
IF (NKL(NR) .EQ.O) GOTO 392 
WRITE (2) (ANSI I, J!,J = 1, NPROB) 

GOTO 397 

392 WRITE (2) I TEMPI I, J ) , J=l, NPROB ) 

397 CONTINUE 
GO TO 398 

395 DO 396 1=5,8 

396 WRITE 12) I ORE I I . J > , J= 1, NPROB ) 

398 CONTINUE 
GO TO 391 

370 IFIN-EO.NSEG) GO TO 380 
IF(NKLINR) .EQ.Oi* GO TO 375 
DO 371 1=1,4 

371 WRITE! 2 ) I ANSI I , J ) , J= 1, NPROB ) 

GO TO 376 

375 DO 372 1=1,4 

372 WRITE! 2 ) I T EMPI I , J > , J = l, NPROB ) 

376 DO 373 1=1,4 

373 WRITEI2) I DRE 1 1 , J ) , J = 1 , NPROB ) 

GO TO 391 

380 CONTINUE 

DO 381 1=5,8 

381 WRITE I 2 ) IDREII,J),J*1, NPROB) 

IFINKLINR) .EQ.O) GO TO 385 

II = I SKL22-3 

III = ISKL22 

DO 382 I=II,III 

382 WRITEI2) ( ANS 1 1 , J ) , J=1 , NPROB ) 

GO TO 391 
385 II = M8-3 
III = M8 
DO 383 I=II,III 

383 WRITEI21 I TEMPI I , J ) , J= 1 , NPROB ) 

391 CONTINUE 

REWIND 2 

999 DO 201 NS= 1 , NSEG 

READ (9) IIXK1112I I , J ) , J = 1 ,NH8 ) , 1 = 1 ,NH4 ) , IGEOM ,G1 

ISEG=0 

NR1=NR-1 

IF! NR 1. EQ.O) GOTO 8 
DO 7 1=1, NR1 

7 ISEG=ISEG+NSTI I ) 

8 I SEG= I SEG+NS 

T I C= SAVTICI ISEG) 

GO TO (21,22,23), IGEOM 


1700600 
1700610 
1700620 
1700630 
1700640 
1700650 
1700660 
1700670 
1700680 
1700690 
1700700 
1700710 
1700720 
1700730 
1700740 
1700750 
1700760 
1700770 
1 700780 
1700790 
1700800 
1700810 
1700820 
1700830 
1700840 
1700850 
1700860 
1700870 
1700880 
1700890 
1700900 
1700910 
1700920 
1700930 
1700940 
1700950 
1700960 
1700970 
1700980 
1700990 
1701000 
1701010 
1701020 
1701030 
1701040 
1701050 
1701060 
1701070 
1701080 
1701090 
1701100 
1701110 
1701120 
1701130 
1701 140 
1701150 
1701160 
1701170 
1701180 
1701190 
1701200 
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21 SN = SINITIC) 

CS = COS ( TIC ) 

GO TO 25 

22 SN = COS( 1 . 570796-G1 ) 

CS = S INI 1 .570796-G1 I 
IF (Gl.NE.O.O) GO TO 25 
SN = 0.0 

CS = 1.0 
GO TO 25 

23 SN = 1.0 
CS = 0.0 

25 CONTINUE 

IF ( NSEG.EQ. 1 ) GO TO 80 
DO 78 I = 1 i 8 

78 READ (2) ( DS E( I , J ), J = 1, NPROB ) 

80 CONTINUE 

00 302 J = 1 » NH4 
DO 302 1=1, NH4 
302 ROTD( I,J)=0.0 

DO 305 J=1 » NH4, 4 
ROTDI J, J )=1 .0 
ROTDI J + l, J«-2)=CS 
R0TDIJ+2,J+1)=-CS 
ROTOIJ+1, J+l I=-SN 
ROTDI J+2,J+2)=-SN 

305 ROTO I J+3 , J+3 1 = 1 . 0 
00 306 J=l, NPROB 
DO 306 1=1, NH4 
DICSI I , J 1=0.0 

DO 306 K=1,NH4 

306 DICSI I,J) = DICS( I, J) ♦ROTO I I ,K »*DSE I K, J > 
READ! 9) I IXL1II, J),J=1, NPROB 1,1=1, NHA) 

DO 202 J=l, NPROB 

DO 202 1=1, NH4 
TDSEI I , J 1=0.0 
DO 202 K=l , NH8 

202 TDSEII,J> = TDSEI I,J)+XK1112l I , K)*DSE I K, J ) 
DO 203 J=l, NPROB 

DO 203 1=1, NH4 

203 T0SEII,JI=T0SEII,J)+XL1I I,J) 

00 301 J= 1 « NH4 

DO 301 1=1, NH4 
301 ROTDI I,J)=0.0 

DO 204 J = 1 , NH4, 4 
ROT IJ,J)=-1.0 
ROTI J+i, J+2)=-CS 
ROT I J+2, J + l ) = CS 
ROTI J+l, J+1)=SN 
ROTIJ+2, J*2)=SN 

204 ROTI J+3, J*3I=1.0 
00 205 J=l, NPROB 
DO 205 1=1, NH4 

F ICS 1 1 ,J 1=0.0 
DO 205 K=1,NH4 

205 FICSII,J)=ROTII,K)*TOSEIK,J)*FICSII,J) 

00 402 J= 1 » NPROB 

00 402 1=1, NH4 
I I=I+NH4 

YICSII, J)=FICSI I, J) 

402 YICSUI,J) = DICSII,J) 

WRITEI4) I lYICSII.JI, 1 = 1,8 »,J = 1, NPROB I 


1701210 

1701220 

170123IT 

1701240 

1701250 

1701260 

1701270 

1701280 

1701290 

1701300 

1701310 

1701320 

1701330 

1701340 

1701350 

1701360 

1701370 

1701380 

1701390 

1701400 

1701410 

1701420 

1701430 

1701440 

1701450 

1701460 

1701470 

1701480 

1701490 

1701500 

1701510 

1701520 

1701530 

1701540 

1701550 

1701560 

1701570 

1701580 

1701590 

1701600 

1701610 

1701620 

1701630 

1701640 

1701650 

1701660 

1701670 

1701680 

1701690 

1701700 

1701710 

1701720 

1701730 

1701740 

1701750 

1701760 

1701770 

1701780 

1701790 

1701800 

1701810 
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201 CONTINUE 1701820 

REWIND 2 1701830 

100 CONTINUE 1701840 

REWIND 1 1701850 

REWIND 4 1701860 

REWIND 8 1701870 

RETURN 1701880 

END 1701890 
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SUBROUTINE LEBEGE 


The subroutine link LEBEGE receives the YICS array for each segment from 
INITAL via Tape The subroutine FIXEM is called to integrate the 

differential equations of each segment, under true load conditions. FIXEM 
is identical to subroutine SETUP, vhile WAND corresponds to subroutine 
MAGIC and only consideration of the OVERLAY structure dictates the change 
in names. The subroutines TOBAR, TEMDEG, PIYCO, and PLYNE are similarly 
equivalent to ROBOT, GEOMET, PLICO, and PLINE discussed previously. 

The results of the final integration sequence are the forces and deflections 
at the beginning, intermediate, and end points of each segment. These 
are always the incremental values. The updating for current load step 
is accomplished in subroutine SHPLAS. 

Subroutine GRAPH : This subroutine controls the system graphical routines. 

GRAPH prints the titles and passes the graphical display points to the 
necessary system routines, which utilize a Stromberg-Carlson 4020 plotter. 
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LEBEGE 




















FOR* IS LEBEGE.LEBEGE 

SUBROUTINE LEBEGE 

INTEGER SAVJTC,SAVSTP,Q, THICK 

INTEGER XN 

DOUBLE PRECISION YNEM.YPREO 

COMMON STORY 1 16 ) * XMAT (270, 10), ST 0(10), SA0USI30 1 »RADUS(30) 

COMMON TA0US(30I,UADUS< 30 ) tSAVTIC (900 > 

COMMON XNtTEFREE* TIC*PHI«STOP*RESTOP*RTICK*GL*XNL(3) *NH 
COMMON NST (30 ) , NKL 1 30 ) * NXMATI 20 ) . SAVJTC < 30) » SAVSTP (3 0) » JRT IC 1 30 ) 
COMMON JRST0P(30) *NREG* NMPT*NRC*NSC *NI X * IERROR*KGEOM * IGEOH* I STTAB 
COMMON KELVIN* IBEGIN*NPROB*NSEG*NERROR*Q«THICK«NOJS* NLINKS tNLCASE 
COMMON NT$KL,NZ ,NBCT, L INPUT, NTRKL *NPASS . XN1 , KBC »NRINGS 
COMMON LODE* (CYCLE* LOISTL 

COMMON /ARING/ NRING(28),AMAT(30,8),RSIG(12),REPS(12 ), RALPH! 12), 

C RBAPHI 12 ) 

COMMON /SNILPS/ ANG, PS I ( 100 ) ,RAD( 100) , CURL 1 100) ,CUR2 (100 ) « 

1 0R10P ( 100 ) ,ZI ( 14).,RI ( 14) ,NRZIN 

COMMON /MAGIQ/ KKNT.TII ,T IK.TOK.TOO 
COMMON /LASTEQ/ YPREOI 8 ) , YDOT ( B) , YASAVE ( 8) , 

YANTH* YAMTH,YAMPT * YANPT, YAOPH*YAQPH« YAQTH, YAJPH. 
S«SN«CS* SNSQ,CSS0,TAN«SEC*CN*X1CS*X1 SN,TN, 

X1R0* X1R0SQ*X 1SNR0* X1CSR0* CN1R0 «SN1R0*CS1R0* 
X1R1«X1R2*CS1R1,C S1R2* SN1R1, X1R1SQ*R2SQ*R0,BESQ, 
R0SQ*XNSQ,BETA«R1,R2,S1,R100T,R1SQ, 

XNTTH, XNTPH, XMTTH, XMTPH, XFTHLO, XFPHL 0, XF ZELO, 
XMTHLD,XHPHLD, ETHET ,EPHI ,XGPT ,ALPHTH »ALPHPH, 

XNUTP, XNUPT t XC 1 1 • XC22, XC 15, XD33 *XD22 ,X021 *X012 * 
XK11,XK12,XK21,XK22,XK33,X011, 

M*1*SITIN« SI TOUT « SIP IN,Sl POUT »TPT IN.TPTOUT * 
ZBRIN, ZBROUT, SCR I PA « SCR IP I ,SIF IN, SIFOUT *TZEPH»TZETH 
,XNPHI,BETTA,ZETTA,XCI6 

, RMOSS , RMOSN, YLDST,ROC , HP ,FPLUH *GPLUH *TMON 
* RMOSSY,RMOSN Y ,RMOSXY» RMONXY 
, RMQSNS, RMOSSS « S IGOXS , RMOSNR , RMOSSR* SI GOXR 
COMMON /PLSTIC/ 10, JO, IOR, JOR, KOR I ,NEO 
COMMON /PLS/ OMEGA, 1M0RD,XMER0,XPRES,XM0NT 

COMMON /MOOD/ SAVYI 53 ) ,NPLEV,NLPO,NPLA( 21 ), STRI 6) ,SI GMAI 3,21 ), 

C S EPS I 3, 21 ) ,SALPH( 3,21), SBAPH( 3,21),STEPS(3,21) , 

0 EFFI2D, STSRNI 3)«NPLAST(3),STSIG(3),STREPS(3)« 

M STALPHI3), STBAPH 1 3 ) , EFFST C 3 ) ,NPLEVS( 3) 

COMMON /CMAIN/ Z ETA1 1 2 I ) ,ZETA2( 2 1 ), NODE, ALF C 4) ,CE ( 4) ,NLRS,HI ,HO,T 
COMMON /CDISP/ P 

COMMON /RHO/ ER , ES,CPH,CTH, APH, ATH, SPH, STH, ALPHS, ALPHR,TS,TR,SNB, 

C CSB 

COMMON /GRAF IX/ XI 100 ) , Y ( 100, 9 ) ,NGRAPH,LDEF I 9) ,NGR ,JCYC ,NFLAG» JAM, 
C JNSC 

DIMENSION LST ( 13 ) , Y0EV( 8),YICS(8),YNEM(8) 

DI MENS ION XKFI 128 ) , TBOEL ( 8 ) , FMDELI 8 ) . YCORR ( 8 ) 

DIMENSION STI 30, 31 ) «XLAYER I 26 ) 

EQUIVALENCE* (YNEW(l).XKF(l)) 

REMIND 1 

600 FORMAT ( 1H ,8 1 E14.7, 2X )/ 1 3X, 81 E 14.7, 2X ) ) ) 

KSC * 0 
JAM =1 
JNSC -0 

DO 451 I=1,NREG 
451 KSC * KSC ♦ NST I I ) 

LSC ■ 0 

902 LSC = LSC ♦ 1 
JCYC * 0 


1 

2 

3 

4 

5 

6 

7 

8 
9 
A 
B 
B 
C 
D 
D 


1800010 
1800020 
1800030 
1800040 
1800050 
1800060 
1800070 
1800080 
1800090 
1800100 
1800110 
1800120 
1800130 
1800140 
1800150 
1800160 
1800170 
1800180 
1800190 
1800200 
1800210 
1800220 
1800230 
1800240 
1800250 
1800260 
1800270 
1800280 
1800290 
1800300 
1800310 
1800320 
1800330 
1800340 
1800350 
1800360 
1800370 
1800380 
1800390 
1800400 
1800410 
1800420 
1800430 
1800440 
1800450 
1800460 
1800470 
1 800480 
1 800490 
1800500 
1800510 
1800520 
1800530 
1800540 
1800550 
1800560 
1800570 
1800560 
1800590 
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1901 

1900 


1725 

1724 


1727 


182 

183 


1726 

606 

651 

1 

1776 

655 

901 

750 


XNTTH =0.0 1800600 
XNTPH = 0.0 1800610 
XMTTH = 0.0 1800620 
XMTPH = 0.0 1800630 
NSC=LSC 1800640 
JNSC=JNSC+1 1800650 
IF I JNSC. LE.NST (JAM) I GO TO 1727 1800660 
NRNG = NRINGIJAM) 1800670 
IF INRNG.EQ.O) GO TO 1900 1800680 

00 1901 1=1. NRNG 1800690 
RE ADI 1 I DUMLNK 1800700 
CONTINUE 1800710 
NNSKL = NKLIJAM) 1800720 
IF INN SKL.EQ.O) GO TO 1724 1800730 
DO 1725 1=1, NNSKL 1800740 
REAO(l) DUMLNK 1800750 
CONTINUE 1800760 
JAM=JAM+1 1800770 
JNSC=1 1800780 
CONTINUE 1800790 
READ! II KGEOM, IGEOM.RGO, ANG.NLRS, STORY 1800800 
RE ADI 1 1 DTAU.OIFF, STEP. OELTA.NAPEX 1800810 
IF IRGO.EQ. 14.01 GO TO 182 1800820 
READtl) G1.G2.G3 1800830 
GO TO 183 1800840 
READU) NRZIN.IIUJI.RU J) , J=1,NRZINI 1800850 
CONTINUE 1800860 
READIl) IT YPE, MAT, THICK, I STTAB .KELVIN ,KORI , TEFREE , NP ,KLUE1 ,KLUE2 , 1800870 

I ANLYZ, NROW 1800880 
DIFF = 1 .0E-04 1800890 
EPSIL = 1 .0E-05 1800900 
ERR = 1.0 E-07 1800910 
IF tNH.NE.O. AND.IBEGIN.NE.il GO TO 1776 1800920 
HR ITE 16, 1726 1 1800930 
FORMAT! 1H1 I 1800940 
IFIJNSC.EQ.il HR ITE I 6,606 I JAM.NST I JAM I ,NKL I JAM I 1800950 
FORMAT I //58X , 13HREG ION NUMBER, I3//35X, 10HTHERE ARE ,I2,14H SEGMENT 1800960 
S AND » 1 2,35H KINEMATIC LINKS WITHIN THIS REGION) 1800970 

1 = RGO 1800980 
WRITE! 6,651 1 JNSC,I,NLRS 1800990 
FORMAT! //13X.15HSEGMENT NUMBER , 12 , 5X, 1 3HSEGMENT CODE ,I2,5X, 1801000 

14HN0. OF LAYERS ,12) 1801010 
CONTINUE 1801020 
NCONT = NROW 1801030 
IF INH.EQ.O.OR. IBEGIN.EQ.il WRITEI6.655) 1801040 
FORMAT I //42X ,47HT ABLE ORDER PHI OR S VS. CROSSECTION PROPERTIES) 1801050 

DO 901 1=1, NROW 1801060 
READIl) (STII,J),J=1,NP) 1801070 
IF INH.NE.O. AN0.IBEGIN.NE.il GO TO 901 1801080 
WR ITE (6,600 I 1ST I I , J I , J= 1,NP I 1801090 
CONTINUE 1801100 
DO 750 J J= 1 ,12 1801110 
LSTIJJ) =0 1801120 
NLCS = NLCASE 1801130 
NLPO * NLRS+1 — 1801140 
KBC = NLPO 1801150 
IF ITHICK.NE.l) KBC • 2.0*NLPO 1801160 
TAPI * NLRS/2 1801170 
DO 290 1=1, NLPO 1801180 
TAP2 =1-1 1801190 
ZETA1III = 1.0-TAP2/TAPI 1801200 



290 ZETA2II) * 1.0-FL0ATI 1-1 ) /FLOAT! NLR S ) 
K=NROW+l 
JJ = 1 
JJ J=6 
MM=1 

DO 17 NLC=1,NICS 
JT * JJ 
JTT= JJJ 
L=*0 

REAO(LODE) (LSTI J ), J=JJ, JJJ) 

IF (LST1 JJ) >8031,19,20 

20 L = LST(JJ) 

19 JJ*JJ+1 

23 IF(LST(JJ>)8031,22,21 

21 L=L+1 

22 IFI JJ.EQ.JJJ ) GOTO 24 
JJ=JJ+l 

GOTO 23 

24 IF (L.EO-O) GO TO 668 
KK = K + L - 1 

00 72 M=K»KK 

RE ADI LODE ) I ST ( M, J ) , J=1 ,NP ) 

72 CONTINUE 

IF 1LSTI JTI.EQ.O) GO TO 660 
KZ => K ♦ LST(l) -1 
K * KZ ♦ 1 
660 CONTINUE 

IF ( NH.NE.O • AND. IBEGIN.NE. 1 ) GO TO 665 
MR 1TE I 6,66 1 ) 


1801210 

1801220 

1801230 

1801240 

1801250 

1801260 

1801270 

1801280 

1801290 

1801300 

1801310 

1801320 

1801330 

1801340 

1801350 

1801360 

1801370 

1801380 

1801390 

1801400 

1801410 

1801420 

1801430 

1801440 

1801450 

1801460 

1801470 

1801480 

1801490 


661 FORMAT ( //31X »84HT ABLE ORDER PHI OR S VS. DISTRIBUTED LOADS IF THE 1801500 


1TA, F PHI. F ZETA, M THETA, M PHI),) 
HRITEC6, 1968) I LSTI J ) , J»JT, JTT » 

1968 FORMAT ( 27H LOAD IDENTIFICATION CLUES ,611/) 
DO 662 N=K,KK 

662 HR ITEI 6, 600 ) I ST( N, J ) , J = 1 ,NP ) 

668 IF (NH. NE.O. AND. IBEGIN.NE. 1) GO TO 665 
WRITEI6.7000 ) 


1801510 

1801520 

1801530 

1801540 

1801550 

1801560 

1801570 


71 


1 FORMAT I////3X.21HPHI (RAO. OR IN. ) 

• 21HDEGRE S 


1801580 

1 

2 1HR ZERO 

, 21HBASE THICKNESS 


1801590 

2 

21HSTEP 

.21HEPSIL0N THETA IN 

/ 

1801600 

3 

3X, 2 1HEPSIL0N THETA 

.21HEPSIL0N PHI 


1801610 

4 

21HGAMMA PHI THETA 

, 2 1HK PHI 


1801620 

5 

21HK THETA 

.21HEPSIL0N THETA OUT 

/ 

1801630 

6 

3X.21HU 

,21HK PHI THETA 


1801640 

7 

21HN THETA 

, 21HN PHI 


1801650 

8 

21HN PHI THETA 

.21HEPSIL0N PHI IN 

/ 

1801660 

9 

3X.21HV 

, 2 1HJ PHI STAR 


1801670 

A 

2 1HM THETA 

,21HM PHI 


1801680 

B 

21HM PHI THETA 

.21HEPSIL0N PHI OUT 

/ 

1801690 

C 

3X.21HH 

, 2 1HT PHI THETA 


1801700 

0 

21HSIGMA THETA IN 

.21HSIGMA PHI IN 


1801710 

E 

21HTAU PHI THETA IN 

,21HGAMMA PHI THETA IN 

/ 

1801720 

F 

3X.21H0MEGA THETA 

.21H0MEGA PHI 


1801730 

G 

21HSIGMA THETA OUT 

, 21HSIGMA PHI OUT 


1801740 

H 

21HTAU PHI THETA OUT 

,21HGAMMA PHI THETA OUT 

) 

1801750 

WRITEC6.7001) P 



1801760 

F0RMATI////50X, 'CYCLE', F8.0) 



1801770 

i CONTINUE 




1801780 

K « K ♦ L 

- LSTIJT) 



1801790 

JJ=JJJ*1 




1801800 

J J J= JJ+5 




1801810 


133 , 



17 MM=MM+1 
590 CONTINUE 

READ(l) IS,SAVJTC(IS)*SAVSTP( IS)* STORY 

NSAVE = NROW 

JJ=NPR0B*6 

LT=0 

DO 15 J=1,JJ 
15 LT=LT+LST(J) 

NT OT AL=LT+NSAV£ 

NEONS=8*NPROB 
TIC = ST ( 1 , 1 ) 

STOP a STIl.NPJ 

REA0(4) (YICS(I),I=1,NEQNS) 

NC YC=0 
KKNT = 0 
NS AVE=NROW 
IEND=0 
NPR = 1 
PR INT=T I C 
OT A=DTAU 
DTAU=0.0 

READI 10) SAVY.NPLEV.NPLA, SIGMA, SALPH.SBAPH, STEPS, STR ,EFF , STSRN, 

1 NPLAST , STSIG, STREPS, STALPH, STBAPH ,NPLE VS, E FF ST ,SEPS 

59 CALL FIXER ( MAGIN.MAGOUT , TIC , STEP , NEONS ,OTAU,EPSIL , DELTA , ERR, TIME, 

1 DTIME, YICS,YPREO, YCORR, YDOT , YNEW, YDE V,FHD EL.TBDEL ) 

GOTO 61 

60 CALL WAND( MAGIN, MAGOUT, TIC, STEP, NEONS, DTAU.EPSIL, DELTA, ERR, TIME, 

1 DTIME, Y ICS, YPRED, YCORR, YDOT, YNEW, YDEV ,FWDE L» TBDEL ) 

61 IF(MAGOUT.LE.O) GOTO 25 
IFITIHE.GT.STOP) GOTO 62 
IFITIME.LT. STOP) GOTO 63 

64 I END=-1 
GOTO 67 

62 IF(TIME.LE.(STOP+OIFF) ) GOTO 64 
GOTO 8001 

63 IFI(STOP-OIFF).LE.TIME) GOTO 64 
IFI(TIME+DTIM6).GT.ST0P) GOTO 65 
IF(PRINT.GT.TIME) GOTO 66 

PR INT=T IME+DTA 
67 CONTINUE 
NPR =1 

IF (TIME. EQ. TIC) NPR = 0 
6450 IF(IEND.GT.O) GO TO 8002 
IF ( IEND.LT.0 I GOTO 150 
MAGIN = 0 
GO TO 60 
66 MAGIN=0 
NPR a 0 
GOTO 60 

65 DT IME=STOP-T IHE 
DELTA=0.0 
GOTO 67 

75 NCYC=NCYC+1 

IF (NCYC.NE.1.AN0.KKNT.NE.4) GO TO 175 
IF ( ( T IME+ST EP 1 .GT. ( STOP-0 IFF ) ) NPR = l 
CALL SHPLAS ( NCYC ,NAPEX , NPR , STEP ) 

NPR = 0 

175 MAGIN = -l 
GOTO 60 
25 PH I=T IME 
ARG-PHI 


1801820 

1801830 

1801840 

1801SS0 

1801860 

1801870 

1801880 

1801890 

1801900 

1801910 

1601920 

1801930 

1801940 

1801950 

1801960 

1801970 

1801980 

1801990 

1802000 

1802010 

1802020 

1802030 

1802040 

1802050 

1802060 

1802070 

1802080 

1802090 

1802100 

1802110 

1802120 

1802130 

1802140 

1802150 

1802160 

1802170 

1802180 

1802190 

1802200 

1802210 

1802220 

1802230 

1802240 

1802250 

1802260 

1802270 

1802280 

1802290 

1802300 

1802310 

1802320 

1802330 

1802340 

1802350 

1802360 

1802370 

1802380 

1802390 

1802400 

1802410 

1802420 
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IF (KKNT.EQ.3) 1802430 
IRE ADI 10) SAVY.NPLEV.NPL A, SIGMA, SALPH.SBAPH, STEPS, STR,EFF,STSRN, 1802440 
1 NPLAST , STS I G» STREPS, STALPH, STBAPH.NPLE VS ,E FFST.SEPS 1802450 



LL=NP+ 1 



1802460 


DO 51 I = 1 , NP 



1802470 


I F ( ARG-ST ( 1 » I ) ) 52,55,51 



1802480 

52 

IFII-1) 55,55,54 



1802490 

51 

CONTINUE 



1802500 


I = NP 



1802510 


GO TO 55 



1802520 

54 

DO 57 I K=2« NTOTAL 



1802530 

57 

ST(IK,LL)=ST(IK,I-1)+($T( IK , I )-ST I IK , I-i ) )* I ARG- 

ST(1 ,1-1 ) ) / ( ST( 1 » I 

1802540 

1 ) -ST ( 1 . I -1 ) ) 



1802550 


GOTO 80 



1802560 

55 

00 58 IK=2, NTOTAL 



1802570 

58 

ST(IK,LL)=ST(IK,I) 



1802580 

80 

CONTINUE 



1802590 


THE UPOATEO INTERPOLATED VALUES OF 

THE MATERIAL 

PROPERTY COEFFIC 

1802600 


I ENTS ARE FOUND IN THE XMAT TABLE 

AND STORED IN 

THE XLAYER ARRAY 

1802610 


L= ( MAT-1 )*2+ 1 



1802620 


I I =NXMAT ( L ) 



1802630 


I I I = NXMAT ( L + l ) 



1802640 


LL=NP+1 



1802650 


L=NROM + 1 



1802660 


M= 1 



1802670 


GOTO (91, 92, 93, 93), KELVIN 



1802680 

91 

ARG = (ST(L,LL)+ST(L+l,LL)+ST(L+2, 

LLKSTIL*3,LL))/4.0 

1802690 


GOTO 94 



1802700 

93 

CONTINUE 



1802710 


ARG = STINROW+l.LL) 



1802720 

94 

DO 104 I = 2,10 



1802730 


IF 1 ARG-XMAT ( I I , I ) ) 121,123,104 



1802740 

121 

IF (1-2) 8007,8007,124 



1802750 

104 

CONTINUE 



1802760 


GOTO 8067 



1802770 

123 

L-II+1 



1802780 


DO 122 J=L, III 



1802790 


XLAYER(M)=XMAT(J,I) 



1802800 

122 

M=M+1 



1802810 


GOTO 111 



1802820 

124 

L= I 1+1 



1802830 


00 125 J=»L,III 



1802840 


XLAYER! M)=XMAT(J, I- 1 ) ♦( XMAT( J , I )-XMAT( J, 1-1 ) )* ( ARG-XMAT ( I I , 1-1 ) ) / 

1802850 


1 (XMAT( II, I )-XMAT( 11,1-1) ) 



1802860 

125 

M=M+1 



1802870 


GOTO 111 



1802880 

92 

L = II ♦ 1 



1802890 


DO 922 J=L» III 



1802900 


XLAYERl M )= XMAT ( J , 1 ) 



1802910 

922 

M=M+1 



1802920 

111 

CONTINUE 



1802930 

115 

GO T0(101,102,103),ITYPE 



1802940 

101 

ETHET = XLAYERl 1) 



1802950 


XNUTP =XLAYER( 2) 



1802960 


ALPHTH = XLAYER ( 3 ) 



1802970 


EPHI = ETHET 



1802980 


XNUPT= XNUTP 



1802990 


ALPHPH * ALPHTH 



1803000 


XGPT = ETHET/(2.0*( 1.0+XNUPT) ) 



1803010 


N = 4 



1803020 


GO TO 105 



1803030 
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102 

ETHET = XLAYERU) 

1803040 


EPHI = XLAYERI 2 ) 

1803050 


XNUTP = XL AY ER( 3) 

1803060 


ALPHTH = XL AYER I 4 3 

1803070 


ALPHPH = XLAYER( 5 ) 

1803080 


XGPT = XLAYER16 3 

1803090 


XNUPT = ETHET*XNUTP/EPHI 

1803100 


N = 7 

1803110 


GO TO 105 

1803120 

103 

ETHET = XLAYERI 1 ) 

1803130 


EPHI = XL AYERI2 1 

1803140 


XNUTP= XLAYERI 3 ) 

1803150 


ALPHTH = XLAYERI4) 

1803160 


ALPHPH = XL AYER ( 5 3 

1803170 


XGPT = XLAYERI6 ) 

1803180 


ER = XL AYER (171 

1803190 


ES = XLAYERI 18) 

1803200 


ALPHR = XLAYERI 19 ) 

1803210 


ALPHS = XL AYER ( 20 3 

1803220 


RMOSSR = XLAYERI 21 3 

1803230 


RMOSNR = XLAYERI22) 

1803240 


SIGOXR = XLAYER (23) 

1803250 


RMOSSS = XLAYERI 24) 

1803260 


RMOSNS = XLAYERI 25 ) 

1803270 


SIGOXS = XLAYER 1 26 ) 

1803280 


XNUPT = ETHET*XNUTP/EPHl 

1803290 


N = 7 

1803300 

.105 

CONTINUE 

1803310 


RMOSS = XLAYERI N 3 

1803320 


RMOSN = XL AYER! N+ 1 3 

1803330 


SIGOX = XLAYERI N+2 3 

1803340 


IF IITYPE.NE.l) GO TO 108 

1803350 


SIGOY * SIGOX 

1803360 


SIGOZ = SIGOX 

1803370 


SIGXY = SIGOX/ S0RTI3.0) 

1803380 


GO TO 109 

1803390 

108 

CONTINUE 

1803400 


SIGOY = XLAYERIN+3) 

1803410 


SIGOZ = XLAYERI N+4 ) 

1803420 


SIGXY = XLAYERI N + 5 3 

1803430 


RHOSSY = XLAYER I N+6 3 

1803440 


RMOSNY = XLAYER! N+7 3 

1803450 


RMOSXY = XLAYERI N*8 3 

1803460 


RMONXY = XLAYERI N*9 3 

1803470 


IF IKORI.GT.O) GO TO 227 

1803480 

109 

CONTINUE 

1803490 


IF I RMOSN. EQ. 0.0 3 GO TO 225 

1803500 


YLOST = SIG0X4SIG0X 

1803510 


IF I RMOSS .NE. 0.0 3 GO TO 224 

1803520 


ROC = YLOST*EPHI*RMOSN/l l.O-RMOSN) 

1803530 


GO TO 227 

1803540 

224 

ROC' * 2 . 333333*EPHI*YLDST/RM0SN 

1803550 

225 

RMOSN = RH0SN-1.0 

1803560 

227 

TEM1 = S IGOX*S IGOX 

1803570 


TEM2 = SIGOY*SIGOY ' 

1803580 


TEM3 = S IGOZ*SIGOZ 

1803590 


TEM4 = 0.5/TEM1 

1803600 


TEM5 = 0.5/TEM2 

1803610 


TEM6 = 0.5/TEM3 

1803620 


HP = TEM4+TEM5-TEM6 

1803630 


TWON = 1.0/ISIGXY*SIGXY3 

1803640 
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FPLUH = 1.0/TEM2 
GPLUH * 1.0/TEM1 

CALL TOBAR < ST, KLUE2.NROH.LL, E 1 , E2, HI ,HO , T , TI I , TOO ,T IK , TOK , 
1 0EGRES.G2.G3.TIME.NC0NT) 

IF INIX.NE.O) GO TO 9999 
LL=NP«-1 

IF(XKll.EQ.O.O) GOTO 8101 
IFUTYPE.EQ.3.AN0.XK12.EQ.0.) GO TO 8102 
IFUTYPE.EQ.3.AND.XK21.EQ.0.) GO TO 8103 
IF1XK22.E0.0.0) GOTO 8104 
IF (XK33. £0.0.0) GOTO 8105 
IFtXDll.EO.O.O) GOTO 8106 
IFUTYPE.EQ.3.ANO.X012.EQ.O.) GO TO 8107 
IF(ITYPE.EQ.3.ANO.XD21.EQ.O.) GO TO 8108 
IF(X022.E0.0.0) GOTO 8109 
I F (XD33. EQ .0.0) GOTO 8110 
NL*0 

JF = NPROB 
K = NROH 
DO 7 M= 1 » JF 
I = ( M-l ) *8 + 1 
NL=NL*1 
XFTHLD=0.0 
XFPHL0=0.0 
XFZELD=0 .0 
XMTHLD=0.0 
XMPHL0=0 .0 
I R=NL*6-5 

IF(LST( IR(.NE.O) K=K+LST ( I R ) 

IF (LST(IR+l).EQ.O) GOTO 44 
K=K*1 

XFTHLO=ST(K,LL) 

44 IF(LST( IR+2I.EQ.0) GOTO 45 
K=K*1 

XFPHLD = ST ( K, LL )+XMERO* IHORO 

45 IFILSTI IR+3) .EQ.O) GOTO 46 
K=K*1 

XFZELD = ST ( K, LL ) +XPRES* IWORO 

46 IF(LST( IR*4) . EO . 0 ) GOTO 47 
K=K+l 

XMTHLD = ST ( K, LL ) +XHONT* I WORD 

47 IFILSTI IR + 5).EQ.O) GOTO 48 
K=K+1 

XNPHLD=ST ( K , LL ) 

48 CONTINUE 

50 IF ( ISTTAB.GE.3.AN0.ISTTAB.LE.9) GO TO 4002 
CALL OOE 1 
GO TO 77 
4002 CALL 0DE2 
77 CONTINUE 
7 CONTINUE 
GOTO 75 

8001 IERROR=8001 
NERROR =11 
GOTO 8888 

8002 I ERROR=8002 
NERROR = 12 
GOTO 8888 

8007 IERR0R=8007 
NERROR = 15 
GOTO 8888 


1803650 
1803660 
1803670 
1803680 
1803690 
1803700 
1803710 
1803720 
1803730 
1803740 
1803750 
1803760 
1803770 
1803780 
1803790 
1803800 
1803810 
1803820 
1803830 
1803840 
1803850 
1803860 
180387C 
1803880 
1803890 
1803900 
1803910 
1803920 
1803930 
1803940 
1803950 
1803960 
1803970 
1803980 
1803990 
1 804000 
1804010 
1804020 
1804030 
1804040 
1804050 
1804060 
1 804070 
1804080 
1804090 
1804100 
1804110 
1804120 
1804130 
1804140 
1804150 
1804160 
1804170 
1804180 
1804190 
1804200 
1804210 
1804220 
1804230 
1804240 
1804250 
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8031 I£RRQR=8031 
NERRQR = 9 

8067 I ERR0R= 8067 
NERRQR * 16 
GOTO 8888 

8101 I ERROR = 8101 
NERRQR = 17 
GOTO 8888 

8102 I ERROR = 8102 
NERROR * 18 
GOTO 8888 

8103 I ERROR * 8103 
NERRQR = 19 
GOTO 8888 

8104 IERRQR = 8104 
NERRQR = 20 
GOTO 8888 

8105 IERRQR = 8105 
NERRQR = 21 
GOTO 8888 

8106 IERRQR = 8106 
NERRQR = 22 
GOTO 8888 

8107 IERRQR = 8107 
NERRQR =23 
GOTO 8888 

8108 I ERROR = 8108 
NERRQR = 24 
GOTO 8888 

8109 IERRQR = 8109 
NERROR = 25 
GOTO 8888 

8110 I ERROR = 8110 
NERRQR = 26 

8888 NIX»1 

GO TO 9999 

150 IF (NGR.EQ.U CALL GRAPH (KGEOM) 
IF (LSC.LT.KSC) GO TO 902 

9999 RETURN 
END 


1804260 

1804270 

1804280 

1804290 

1804300 

1804310 

1804320 

1804330 

1 804340 

1804350 

1804360 

1804370 ' 

1804380 

1804390 

1804400 

1804410 

1804420 

1804430 

1804440 

1804450 

1804460 

1804470 

1804480 

1804490 

1804500 

1804510 

1804520 

1804530 

1804540 

1804550 

1804560 

1804570 

1804580 

1804590 

1804600 

1804610 

1804620 

1804630 

1804640 

1804650 
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FOR. IS FIXER. FIXER 

SUBROUTINE FIXER (MAGIN, RAGOUT, TIC, STEP, NEQNS.DTAU, 

1 EPS IL, DELTA, ERR, TIRE, DT IRE, YICS, YPREO, 

2 YCORR, YDOT, YNEW, YDEV, FWDEL. TBDEL) 

C RUNGE KUTTA RAGIC (REVISED) SINGLE PRECISION FORTRAN IV 

D IRENS I ON YICSI 1).YPRED( 1), YCORR! l), YOOTI 1), YNEW( -II, 

I YDEV( I ) , FWDEL ( 1 ) .TBDEL ( 1 ) 

DIRENS ION C l 3 ) » D( 3 ) 

CORRON /RAG IQ/ KKNT 

DOUBLE PRECISION YNEW, YPREO 

OATA C,0 / .5,.5,1.0,.5,.0,.5/ 

RSET=1 
TIRE E TIC 
TAU = TIC 

IF (DELTA ) 200,201,200 

200 DT IRE * 0.0078125 
GO TO 225 

201 DT IRE = STEP 

225 DO 102 I » 1, NEONS 
YOEV(I) * 0.0 
YPRED(I) = YICS(I) 

YCORR(I) = YICS(I) 

102 YNEM(I) = YICS(I) 

RAGOUT =-2 
GO TO 264 

5555 CONTINUE 

ENTRY MANO ( RAG IN, RAGOUT, TIC, STEP, NEQNS.DTAU, 

1 EPSIL, DELTA, ERR, TIME, OT IRE, YICS, YPR ED, 

2 YCORR, YOOT, YNEW, YDEV, FWDEL , TBDEL ) 

5556 CONTINUE 
MSET*=2 

IF (RAGOUT) 305,101.101 
101 IF(RAGIN) 21, 27, 14 
27 K » 0 

DO 202 I = 1 , NEONS 

202 YNEW(I) * YPRED(I) 

21 K = K ♦! 

K If UT = If 

210 DO 2 I = 1, NEONS 
GO TO (9, 6, 7, 4, 111, K 
9 FWDEL ( I ) = YOOT ( I ) 

GO TO 105 

6 TBDEL( I) = YDOT ( I ) 

GO TO 105 

7 TBDEL! I ) = TBDEL ( I ) ♦ YOOTI I) 

105 YPREO! I ) = YNEW ( I ) ♦ C(K )*DT IRE* YOOT (I) 

GO TO (2, 2, 400), K 
400 YCORR! I) * YPRED(I) 

2 CONTINUE 

TIME = TIRE ♦ D ( X )*0T IRE 

99 MAGOUT =0.0 
264 RETURN 

4 DO 8 I = 1, NEONS 

YPREO ( I ) = YNEW ( I ) ♦ OTIRE*(FWOEL( I ) ♦ 2.*TBDELIII ♦ YD0T(I))/6. 

8 YDEV ( I ) = YCORR! I) - YPREO(I) 

GO TO 99 

11 IF (DELTAI80, 5,80 
80 00 13 I * 1, NEONS 

IF (EPS IL*ABSI YCORR! II) ♦ ERR - ABSC YDE V( I ) ) ) 14,13,13 
13 CONTINUE 


1900030 

1900040 

1900050 

1900060 

1900070 

1900080 

1900090 

1900100 

1900110 

1900120 

1900130 

1900140 

1900150 

1900160 

1900170 

1900180 

1900190 

1900200 

1900210 

1900220 

1900230 

1900240 

1900250 


1900270 . 

1900280 

1900290 

1900300 

1900310 

1900320 

1900330 

1900340 

1900350 

1900360 

1900370 

1900380 

1900390 

1900400 

1900410 

1 900420 

1900430 

1900440 

1900450 

1900460 

1900470 

1900480 

1 900490 

1900500 

1900510 

1900520 

1900530 

1900540 

1900550 

1900560 

1900570 
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IF f S1GB) 15, 15* 205 
205 SIGB = 0.0 
GO TO 5 
15 SIGB = 0.0 

DO 207 I = 1, NEONS 

IF (ERR /100.+ OEU TA*ABS (YCORR(IH 

207 CONTINUE 

OTIME = 2.*DTIM£ 

5 00 208 I = 1, NEONS 

208 YCORRCI) = YPREDC1) 

305 IF (OTAU t 19,30.19 

19 IF (TAU - T INE ) 20, 20, 27 

20 TAU = TAU ♦ OTAU 
30 MAGOUT a 2 

GO TO 264 

14 OTIME = DTIME/2.0 

25 IF ( K-3 ) 48, 26, 26 

26 TIME = TIME - OTIME - DTIME 
GO TO 47 

48 TIME = TIME - OTIME 
47 SIGB = +2. 

DO 209 I = 1, NEONS 
209“'YTT0T ( I ) = FMDEL ( I ) 

212 K =0 

GO TO 21 
END 


1900580 

1900590 

1900600 

1900610. 

1900620 

- A8S(Y0EV(im 5,207,207 1900630 

1900640 

1900650 

1900660 

1900670 

1900680 

1900690 

1900700 

1900710 

1900720 

1900730 

1900740 

1900750 

1900760 

1900770 

1900780 

1900790 

1900800 

1900810 

1900820 

1900830 
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FOR, 


C 

771 


S TOBAR, TOBAR 

SUBROUTINE TOBAR ( ST, KLUE2. NROW.LL ,tl, E2 ,HI ,HO, T, TII ,TOO , 

TIK, TOK, DEGRES,G2, G3,TIME,NCONT) 

INTEGER SAVJTC, SAVSTP»Q, THICK 
INTEGER XN1 , XN2 , XN 
REAL *4 12 

DOUBLE PRECISION YPRED 

COMMON STORY ( 16 ) , XMATI 270, 10 ) , STD 1 10 » , S ADUS ( 30) ,RAOUS 1 30 ) 

COMMON T ADUS <30)«UACUS(30)*SAVTIC(900) . 

COMMON XN.TEFREE, TIC, PHI, STOP, RESTOP, RTICK.Gl ,XNLC3) ,NH 
COMMON NST(30),NKL( 30),NXMAT(20> ,SAVJTC(30> .SAVSTP130) ,JRTIC(30> 
COMMON JRSTOPI30) ,NREG,NMPT , NR C, NSC, NIX, IERROR,KGEOM , IGEOM, I STTAB 
COMMON KELVIN, I BEGIN, NPROB, NSEG.NERROR , Q, THICK, NOJS, NL INKS, NLCASE 
COMMON NTSKL-.NZ, NBCT,L INPUT, NTRKL , NPASS , XN1 , KBC .NRINGS 
COMMON LODE, ICYCLE.LOISTL 

COMMON /LASTEQ/ YPREDt 8 > , YDOT ( 8 ) , YASAVE ( 8 ) , 

YANTH, YAMTH, YAMPT , YANPT , YAOPH»YAQPH* YAQTH, YAJPH, 
S,SN,CS,SNSQ,CSSQ , TAN, SEC.CN ,X1CS, XI SN»TN, 
X1RO,X1ROSO,X1SNRO,X1CSRO,CN1RO,SN1RO,CS1RO, 
X1R1,X1R2,CS1R1,CS1R2,SN1R1,X1R1SQ,R2SQ,R0,BESQ, 
ROSQ* XNSQ«BETA»R1 *R2 * SI *R 1D0T , R 1 SQ, 

XNTTH,XNTPH,XMTTH, XMTPH, XFTHLD, XFPHLD, XF 2ELD, 
XMTHLD,XMPHLD,ETHET,EPHI,XGPT,ALPHTH,ALPHPH, 

I XNUTP ,XNUPT,XC11»XC22» XC 15, XD33 t XD22 ,XD21,XD12, 

i XKll,XK12,XK21,XK22,XK33tX011, 

i M,I,SITIN,SITOUT,SIPIN , SI POUT ,TPT IN ,T PTOUT , 

1 ZBRIN»ZBROUT, SCR IPA,SCRIPI,SIFIN,SIFOUT,TZEPH,TZETH 

l ,XNPHI,BETTA,ZETTA,XC16 

, RMOSS, RMOSN, YLO ST ,ROCP ,HP , FPLUH ,GPLUH , T WON 
I , RMOSSY , RMOSNY .RMOSXY, RMONXY 

l , RMOSNS , RMOSS S , S IGOXS, RMOSNR.RMOSSR, SIGOXR 

COMMON /SNILPS/ ANG, PS I ( 100 ) ,RA0(100 ) .CURIUOO) ,CUR2 ( 100 ) , 

OR 1DP ( 100 ),ZI( 14 ) ,RI ( 14 ) ,NRZ IN 

COMMON /RHO/ ER, ES, CPH.CTH, APH , ATH, SPH , STH, ALPHS , ALPHR ,T S ,TR ,SNB, 
CSB 

COMMON /PLS/ OMEGA, IWORD.XMERO.XPRES.XMONT 

COMMON /WOOD/ SAVY ( 53 ) ,NPLE V, NLPO.NPLA ( 21 ) , STR ( 6 ) , SI GMA ( 3, 21 ) , 
SEPS(3,21),SALPH(3,21),SBAPH(3,21),STEPS(3,21), 

I EFF( 2 1 ) ,STSRN ( 3),NPLAST( 3) , STS IG ( 3 ) , ST RE PS (3) , 

I STALPH(3),STBAPH(3),EFFST(3) ,NPLEVS(3) 

DIMENSION ST ( 30 , 31 ) 

EQUIVALENCE ( S INB, SNB ) , ( COSB, C SB ) 

OATA A/'A •/ 

GOTO (771, 772, 773, 77A, 775, 776,7077), KGEOM 
GEOMETRY FOR EL IPSE ( G3=0FFSET DISTANCE ) 

A = G1 
BE=G2 
BETA * BE 
BESQ=BE**2 
ASQ=A**2 
SN = SIN1PHI ) 

CS = COSIPHI ) 

SNSQ = SN**2 
CSSQ = CS**2 

R2 = ASSORT ( 1.0/( SNSQ*BESQ*CSSQ ) ) 

R2SQ = R2**2 
R0=R2*SN 

R1=R2*R2SQ*BESQ/ASQ 

BESQ=BE**2 

R100T=0.0 


2200010 
2200020 
2 200030 
2200040 
2200050 
2200060 
2200070 
2200080 
2200090 
2200100 
2200110 
2200120 
2200130 
2200140 
2200150 
2200160 
2200170 
2200180 
2200190 
2200200 
2200210 
2200220 
2200230 
2200240 
2200250 
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2200270 
2200280 

2200290 
2200300 
2200310 
2200320 
2200330 
2200340 
2200350 
2200360 
2200370 
2200380 
2200390 
2200400 
2200410 
2200420 
2200430 
2200440 
2200450 
2200460 
2200470 
2200480 
2200490 
2200500 
2200510 
2200520 
2 200530 
2200540 
2200550 
2200560 
2200570 
2200580 
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IF (KGEOM.EQ • 1 . AND.8ET A. NE . 1 .0. AND. SN.NE .0.0 IR100T-3. 0* ( R2*BETA/ 
1AI **2*(CS/SNSQ)*(R1*SN-R0) 

I F ( SN. EQ . O.OIGO TO 779 
R2 = R2-G3/SN 
R2SQ = R2**2 
RO = R0-G3 
GO TO 7775 

779 IF (G3 .EQ. O.OIGO TO 7775 
R 1 DOT = 3.0*G3 
RO = -G3 
GO TO 7775 

C GEOMETRY FOR OGIVE 

772 R1=G1 
C=G2 

SN = SINIPHI I 

CS * COS ( PHI I 

IF ( SN.EO.O.O) GOTO 777 

R2=RI-C/SN 

GOTO 778 

777 R2 = 1.0 

778 RO * R1*SN-C 
R100T=0.0 
GOTO 7775 

C GEOMETRY FOR CONE 

773 CS = COS(Gl) 

SN=SIN ( G1 ) 

S=PHI 
Sl=1.0/S 
R2=CS*SN’*PHI 
RO=PHI *CS 
R1D0T=0.0 
GOTO 7775 

C - GEOMETRY FOR CYLINOER 

774 RO * GI 
SN=1.0 
CS=1.0 
R100T=0.0 
GOTO 7775 

C MOOIFIED ELLIPSE 

775 XNEXP=G1 
A =G2 
XNi=l .O+XNEXP 
XN2=1.0/XN1 
XN3=XN1+1 .0 
XN4=XN3+1.0 
XN5=XN4/XN1 
SN = SINtPHI) 

CS = COS ( PHI I 

R2= A*(2.0/( l.O*SN**XNXI )**XN2 

R1=(A/2.0I*(R2/A)**XN3 

R0=R2*SN 

RIDOT=-XN3*A*(SN**XNEXP*CS/A.OI*( 2.0/(1.0+SN**XNl) )**XN5 
GOTO 7775 

C GENERAL GEOMETRY 

776 SN * S IN ( PHI I 
CS = COSIPHI I 
TAN = SN / CS 
SEC = 1.0 / CS 

IF (TIME. EQ. TIC) CALL TEMOEG 
ARG = PHI 
00 20A J=l t 100 
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PHO = PSHJ) 

2201200 


IF (ANG.EQ.A) IF (ARG-PHO) 221.223,204 

2201210 


IF I PHO-ARG ) 221,223,204 

2201220 

221 

IF (J-l) 8502,8502,224 

2201230 

204 

CONTINUE 

2201240 


GO TO 8503 

2201250 

223 

RO * RADI J ) 

2201260 


R1 = CURl(J) 

2201270 


R2 = CUR2IJ) 

2201280 


R100T » 0R1DPIJI 

2201290 


GO TO 7775 

2201300 

8502 

NERROR = 41 

2201310 


GO TO 8888 

2201320 

8503 

NERROR = 42 

2201330 

8888 

NIX = 1 

2201340 


GO TO 8889 

2201350 

224 

SUB1 * ARG-PS I I J-l I 

2201360 


SUB2 = PSI I JI-PSKJ-1J 

2201370 


RO » RAD(J-1)+(RAD( JJ-RAOI J-l ) )*SUB 1/SUB2 

2201380 


R1 = CUR1 I J-l )♦ (CUR1 ( J)-CURl(J-l) )*SUB1/SUB2 

2201390 


R2 * CUR2I J-D + ICUR2I JI-CUR2I J-l ) )* SUB 1/SUB2 

2201400 


R100T = DR1DPI J-1)«-(0R1DP< J l-DRIOPI J-l ) )*SUBl/SUB2 

2201410 


GOTO 7775 

2201420 


1 SOTENSO ID GEOMETRY 

2201430 

7077 

CONTINUE 

2201440 


SN = 5INIPHI ) 

2201450 


CS * COS (PHI) 

2201460 


A =* G1 

2201470 


R2 * A / SQRT(SN) 

2201480 


R 1 = 0.5 * R2 

2201490 


RO = R2 * SN 

2201500 


R1D0T * - ( ( A**2)*0.51*(R1*CS)/R0**2 

2201510 

7775 

TAN*SN/CS 

2201520 


DEGRES = 0.0 

2201530 


IF(IGEOH.EO.l) OEGRES * PHI * 57.29578 

2201540 


ROSQ a R0**2 

2201550 


XNSQ=XN**2 

2201560 


CN»CS*SN 

2201570 


X1CS=1.0/CS 

2201580 


TN*SN/CS 

2201590 


X1R0-1.0/R0 

2201600 


X1R0SQ=1.0/R0**2 

2201610 


X1CSR0*1 .0/ I CS*RO) 

2201620 


CN1R0*CN/R0 

2201630 


SNIROsSN/RO 

2201640 


CS1R0-CS/R0 

2201650 


SNS0=SN**2 

2201660 


CSSQ=CS**2 

2201670 


1 F (KGEOM .EQ.4.0R .KGE0N.EQ.3 ) GOTO 79 

2201680 


R1SQ * Ri**2 

2201690 


R2SQ * R2**2 

2201700 


X1SN=1.0/SN 

2201710 


X1SNR0*! .0/1 SN*RO ) 

2201720 


X1R1<*1.0/R1 

2201730 


X1R2-1.0/R2 

2201740 


CS1R1*CS/R1 

2201750 


CS1R2*CS/R2 

2201760 


SN1R1*SN/R1 

2201770 


X1R1SQ°1 «0/Rl**2 

2201780 

79 

XNTTH=*0.0 

2201790 


XNTPHsO.O 

2201800 
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XHTTH=0 .0 
XMTPH=0.0 

COMPUTATION OF K AND 0 FOR MATERIAL PROPETY INPUT 

HO = 0.0 
T = 0.0 
HI = 0.0 
TS * 0.0 
TR = 0.0 
RHOR = 0.0 
RHOS = 0.0 
RHOI =0.0 
RHOC = 0.0 
CTH = 0.0 
CPH = 0.0 
YBARI = 0.0 
YBARC = 0.0 
YBARO = 0.0 

GO TO (711,600, 711, 32, 33, 34,35, 36, 37, 2 8 , 29, 30 > , I STTAB 
C THICK 

600 GO TO (703, 702, 701, 7011. THICK 

701 H0= STI4.LL) 

702 T = ST ( 3 , LL ) 

RHOC = ST ( NCONT-1 ,LL ) 

703 H I = ST ( 2 , LL ) 

RHOI = ST(NCONT.LL) 

GO TO 40 


2201810 

2201820 

2201830 

2201840 

2201850 

2201860 

2201870 

2201880 

2201890 

2201900 

2201910 

2201920 

2201930 

2201940 

2201950 

2201960 

2201970 

2201980 

2201990 

2202000 

2202010 

2202020 

2202030 

2202040 

2202050 

2202060 

2202070 

2202080 


ST 11 , ST 12, ST 13 
30 H0= ST ( 14, LL ) 

29 T = ST ( 1 3, LL ) 

RHOC = ST( NC0NT-3.LL I 
28 HI= ST ( 1 2, LL ) 

RHOI = ST ( NC0NT-2.LL ) 

RHOS = ST ( NCONT-1, LL I 
RHOR = ST( NCONT ,LL ) 

GJPH= ST ( 2 , LL ) 

GJTH= ST ( 3 , LL ) 

APH = ST (4, LL ) 

ATH = ST(5,LL) 

CPH = ST(6,LL) 

CTH = ST ( 7, LL ) 

XIPH = ST ( 8, LL ) 

XITH= ST (9,LL) 

SPH = ST ( 10, LL ) 

STH = ST(11,LL) 

IF (KELVIN. EQ. 2. OR. KELVIN. EQ. 4) GO TO 40 
ISTAB = ISTTAB-9 
TS = ST ( ISTAB+12.LL ) 

TR = ST( ISTAB+13.LL) 

GO TO 40 

RWAF1.RWAF2.RHAF3 
34 HO a ST( 10, LL) 

33 T = ST (9, LL ) 

RHOC = ST ( NC0NT-2.LL ) 

32 HI = ST ( 8 , LL ) 

RHOI = ST ( NCONT-l, LL > 

RHOS = ST (NCONT ,LL ) 

APH = ST ( 2 ,LL ) 

CPH = ST ( 3,LL) 

X I PH= ST (4,LL ) 
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SPH = ST ( 5f LL ) 

BETTA=ST ( <6,LL) 

2ETTA = ST{ 7 »LL ) 

ATH = APH 

CTH = CPH 

X I TH= XI PH 

STH = SPH 

RHOR = RHOS* IWORD 

IF (KELVIN. EQ. 2. OR. KELVIN. EQ. 4) GO TO 40 
ISTAB = ISTTAB-3 
TS = ST ( ISTAB + 8.LL ) 

TR ■ TS 
GO TO 40 
ISG1, ISG2, ISG3 
37 HO * ST ( 9, LL ) 

36 T = ST ( 8 , LL ) 

RHOC = ST(NC0NT-2,LL> 

35 HI = ST ( 7. LL ) 

RHOI = ST ( NCONT-1 » LL ) 

RHOS = ST C NCONT »LL ) 

APH = ST ( 2»LL ) 

CPH = ST(3,LL> 

XIPH * STI4.LL) 

SPH * ST ( 5»LL ) 

BETTA = ST ( 6 ,LL ) 

ATH * APH 

CTH = CPH 

XITH = XIPH 

STH = SPH 

RHOR » RHOS* IHORD 

IF (KELVIN. EO. 2. OR. KELVIN. EQ.4) GO TO 40 
ISTAB * ISTTAB-6 
TS = ST ( ISTAB+7 t LL ) 

TR = TS 
GO TO 40 
STIOtRWAF 

RANKIN=THSTNO MEANS INTERPOLATE, COMPUTE NTEMP.MTEMP 
RANKIN=NOTHRM MEANS 00 NOT INTERPOLATE ( DO NOT COMPUTE NTEMP.NTEMP 
R ANKI N=THCNST MEANS DO NOT AVERAGE, BUT INTERPOLATE, COMPUTE 

NTEMP, MTEMP 

RANKI N= TH I NHO MEANS INTERPOLATE, BUT 00 NOT COMPUTE NTEMP, MTEMP 

711 CONTINUE 

XKil=ST ( 2, LL ) 

XK12=ST ( 3, LL ) 

XK22 = ST( 4, LL ) 

XK33 = ST ( 5, LL ) 

XD11 = ST (6,LL) 

X012 * ST(7, LL ) 

X022 - ST( 8, LL ) 

XD33 « ST (9,LL) 

XCll * ST ( 10, LL ) 

XC22 = ST ( 11, LL ) 

XC 15 = ST ( 12 ,LL ) 

XC16 * ST ( 13, LL I 
XMERD = ST(NC0NT-2,LL» 

XPRES = ST ( NCONT-1, LL ) 

XMONT * ST (NCONT ,LL ) 

XK21 » XK 12 
X021 = X012 
GO TO 103 


2202420 

2202430 

2202440 

2202450 

2202460 

2202470 

2202480 

2202490 

2202500 

2202510 

2202520 

2202530 

2202540 

2202550 

2202560 

2202570 

2202580 

2202590 

2202600 

2202610 

2202620 

2202630 

2202640 

2202650 

2202660 

2202670 

2202680 

2202690 

2202700 

2202710 

2202720 

2202730 

2202740 

2202750 

2202760 

2202770 

2202780 

2202790 

2202800 

2202810 

2202820 

2202830 

2202840 

2202850 

2202860 

2202870 

2202880 

2202890 

2202900 

2202910 

2202920 

2202930 

2202940 

2202950 

2202960 

2202970 

2202980 

2202990 

2203000 

2203010 

2203020 
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2203030 

40 

CONTINUE 

2203040 


IF (IWORD.EO.l) GO TO 140 

2203050 


RHOR =0.0 

2203060 


RH0S =0.0 

2203070 


RHOI = 0.0 

22030B0 


RH0C =0.0 

2203090 


XNER0 = 0.0 

2203100 


XPRES = 0.0 

2203110 


XH0NT = 0.0 

2203120 

140 

CONTINUE 

2203130 


TEMP3= (1.0-XNUPT * XNUTP ) 

2203140 


GO TO (42,47,49,41) .THICK 

2203150 

41 

GO TO (103, 42, 103, 42, 47, 49, 42, 47, 49,42, 47,49), ISTTAB 

2203160 

2203170 


SINGLE SHEET 

2203180 



2203190 

42 

TEMPI = ETHET4HI 

2203200 


TEMP2= TEMPI * Hl**2 

2203210 


XK11= TEMP1/TEMP3 

2203220 


XOU= TEMP2/(12.0* TEMP3 ) 

2203230 


TEMPI = EPHI*HI 

2203240 


TEMP2= TEMP1*HI**2 

2203250 


XK22= TEMP1/TEMP3 

2203260 


XD22= T6MP2/I12.0* TEMP3 ) 

2203270 


XK33 = XGPT *HI 

2203260 


X033= XK33*H I **2/12.0 

2203290 


Y6ARI = 0.0 

2203300 


YBARC = 0.0 

2203310 


YBARO = 0.0 

2203320 


GO TO 55 

2203330 

2203340 


EQUAL SHEETS 

2203350 

2203360 

47 

CONTINUE 

2203370 


XK 11 = 2.0*ETHET*HI/TEMP3 

2203380 


XK22 = 2.0*EPHI*HI/TEMP3 

2203390 


XK33 = 2.0*XGPT 

2203400 


ZBR = HI+T/2.0 

2203410 


ZBH = { ZBR-H 1/2.0 )**2 

2203420 


XD33 = XGPT*HI*( (HI**2)/6.0+2.0*ZBH) 

2203430 


X011 * HI*(XKll*HI/12.0*2.0*ETHET*Z8H/TEMP3) 

2203440 


XD22 * HI*(XK22*HI/12.0+2.0*EPHI*ZBH/TEMP3) 

2203450 


YBARI = ZBR-HI/2.0 

2203460 


YBARC = ZBR-HI-T/2. 0 

2203470 


YBARO = HI/2.0-ZBR 

2203480 


GO TO 55 

2203490 

2203500 


UNEQUAL FACE SHEETS 

2203510 

2203520 

49 

CONTINUE 

2203530 


ZBR = (HI*HI4HO*HO+2.0*(HO*(HI4T)))/(2.0*(HI4HO)) 

2203540 


ZBHIN = (ZBR-HI/2. 0)**2 

2203550 


ZBHOUT = (ZBR-HO/2. 0)**2 

2203560 


XK11 = ETHET*(HI*HO)/TEMP3 

2203570 


XK22 = EPHI* ( HI *H0 ) /TEMP 3 

2203580 


XK33 = XGPT*(HI+H0) 

2203590 


HI 03 = HI**34H0**3 

2203600 


XD33 = HI03*XGPT/ 12 .0*XGPT* (H I*ZBHIN*HO*ZBHOUT ) 

2203610 


Oil = ETHET4HI03/12.0 

2203620 


XD11 * I D11*ETHET*( HI*ZBHIN*HO*ZBHOUT) ) /TEMP3 

2203630 
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022 * EPHI*H 103/12.0 

X022 - (022+EPHI*(HI*ZBHIN«-H0*ZBH0UT))/TEMP3 
YBARI * ZBR-HI/2.0 
YBARC = Z8R-HI-T/2.0 
Y8AR0 =■ HI/2.0-ZBR 

determine complete constants oepenoent on reinforcement clue 

$5 CONTINUE 

R0I - R0-YBARI*SN 
ROU = RO-YBARO*SN 
ROC = RO-YBARC*SN 
IF (THICK. EQ. 2) HO - HI 

IF (ISTTAB. EQ. 5. OR. ISTTAB.EO. 8. OR. ISTTAB.EQ.il) HO * HI 

03 * RHOI*ROI*HI 

D4 » RHOC*ROC*T 

09 * RHOI*ROU*HO 

DO * 03+D4A05 

XMERO - DO*OMEGA*CS 

XPRES * -OD*OMEGA*SN 

XMONT = -CD3*YBARI+DA*YBARC*05*YBARO)*OMEGA*CS 

IFdSTTAB . EQ.2 ) GO TO 103 

TBARR » ATH/STH 

TBARS * APH/SPH 

ROR - RO-CTH*$N 

ROS * RO-CPHASN 

E A STH=ER* ATH/STH 

EASPH=ES*APH/SPH 

EISPH= ES* X IPH/SPH 

EISTH=> ER* XITH/STH 

01 = RHOR*ROR*TBARR 

02 = RHOS*ROS*TBARS 
OD * Dl+02+03+04+05 

GO TO (58,60,100 ),KLUE2 

ST CLUE (11,12,13) 

58 CONTINUE 

XK 12= XK11*XNUTP 
XK11=» XK11+ EASTH 
XK22= XK22+ EASPH 
XCll* EASTH*CTH 
XC22= EASPH*CPH 
X022 = -XD22-EISPH 

X033* X033 ♦ GJPH/(4.0*SPH>+ GJTH/( 4.0*STH ) 

X012= -X011*XNUTP 
XDil= -X011- EISTH 
XK21 ■ XK12 
XD21 = X012 
XMERO * CO*OMEGAACS 
XPRES = -00*0MEGA*SN 

XMONT = -(01*CTH*D2*CPH«-03*Y8ARI+04*YBARC*D5*YBARO)*OMEGA*CS 

GO TO 103 

RWA CLUE (1,2,3) 

60 CONTINUE 

SINB =S IN( BETTA ) 

COSB =COS( 8ETTA ) 

SN2T04 = 2*( SIN8**4. ) 

D= STH*( COSB-fS INB ) 

EO = ERAATH/O 


2203640 
2203650 
2203660 
2203670 
2203680 
2203690 
2203700 
2203710 
2203720 
2203730 
2203740 
2203750 
2203760 
2203770 
2203780 
2203790 
2203800 
2203810 
2203820 
2203830 
2203840 
2203850 
2203860 
2203870 
2203880 
2203890 
2203900 
2203910 
2203920 
2203930 
2203940 
2203950 
2203960 
2203970 
2203980 
2203990 
2204000 
2204010 
2204020 
2204030 
2204040 
2204050 
2204060 
2204070 
2204080 
2204090 
2204100 
2204110 
2204120 
2204130 
2204140 
2204150 
2204160 
2204170 
2204180 
2204190 
2 204200 
2204210 
2204220 
2204230 
2204240 


147 I 



no non 


SINB2= S INB**2. 

HL » 2.0*(A8S(ZETTA)-ABS(CTHI) 

12=(ATH**3. )/(3* HL**21 
95 XC22 = 2.0*CTH*C0SB**3*ED 
XC15 = 2.0*CTH*C0SB*SINB2*E0 
XC16 = XC15 

GR I* ER* 12/(2.04(1.0 ♦ XNUTP)*D) 

XC11 « CTH*SN2T04/C0SB*EC 
EDI * ER*XITH/D 
SN4T02 * 4.*SINB2 

XD22 = -X022-2.0*C0SB**3*E0I-SN4T02*C0SB*GRI 

TB= 2.0* BETTA 

X033 = X033*( ( 4.0*C0S( TB I* 

1*2*GRI ) / COSB) ♦ (2.0*C0SB*SINB2*EDI ) 

X012 = -XD11*XNUTP-(2.0*C0S8 
1*S INB2*EDI )-( SN4T02*C0SB*GR I I 
XK12- XK11*XNUTP * (2.0*C0SB*SINB2*ED) 
XK22=XK22-M2*C0SB**3*ED) 

XK33=XK33*( 2*C0SB*S INB2*ED ) 

XKll=XKll+( SN2T04*ED/C0SB ) 

XD11 * -XDll-SN2T04*EDI/C0SB-( 

1 SN4T02*C0SB*GR I ) 

XK21 = XK 12 
XD21 = XD12 
GO TO 108 

ISG CLUE (1,2.3) 

100 CONTINUE 

SNB =SIN(BETTA) 

CSB =COS ( BETTA ) 

TBETT A* 2.0*BETTA 
CS28= COS ( TBETTA )' 

0NEC2B=(1.0* CS2B)/2. 

SCB2 =(SNB-CS2B*SNB * 2. ) / ( 2.0*CSB ) 

SN2B “SIN ( TBETTA ) 72. 

XK12“XK11*XNUTP ♦ ( E ASTH*SNB*0NEC2B/CSB ) 

XKli=XKl 1* EASTH*SCB2 

XK22=XK22* EASTH*(CSB/SNB*0NEC2B) 

XK33-XK33* EASTH* SN2B 
XCll = ( EASTH*CTH* SCB2 ) 

XC15=EASTH*CTH*( SNB* 0NEC2B/C SB ) 

XC16=EASTH*CTH*SN2B 

XC22= EASTH*CTH* (CSB/SNB * 0NEC2B) 

XD12=-XDU*XNUTP- E I STH* ( SNB*0NEC2B/CSB ) 

XD11=-XD11- E1STH*SCB2 

XD22 * -X022-EISTH*(CSB/SNB*0NEC2B) 

XD33= X033+ EISTH*SN2B 
XK21 = XK 12 
XD21 = X012 


108 XMERO = ( 00-02 )*0MEGA*C$ 

XPRES = -( 00-02 >*ONEGA*SN 

XMONT = - ( 01*CTH*03*VBARI*04*YBARC*D5*YBARO ) *0MEGA*C S 
103 CONTINUE 

IF (KGEOM.NE .4 ) GO TO 105 
XMERO = 0.0 
XMONT =0.0 
105 CONTINUE 


2204250 

2204260 

2204270 

2204280 

2204290 

2204300 

2204310 

2204320 

2204330 

2204340 

2204350 

2204360 

2204370 

2204380 

2204390 

2204400 

2204410 

2204420 

2204430 

2204440 

2204450 

2204460 

2204470 

2204480 

2204490 

2204500 

2204510 

2204520 

2204530 

2204540 

2204550 

2204560 

2204570 

2204580 

2204590 

2204600 

2204610 

2204620 

2204630 

2204640 

2204650 

2204660 

2204670 

2204680 

2204690 

2204700 

2204710 

2204720 

2204730 

2204740 

2204750 

2204760 

2204770 

2204780 

2204790 

2204800 

2204810 

2204820 

2204830 

2204840 

2204850 
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GOTO (716, 714,715, 7141, KELVIN 

716 Til = ST (NROW+l,LL ) 

TIK = ST ( NROM+2, LL ) 

TOK = ST ( NROW+3 , LL ) 

TOO = ST ( NROW+4* LL ) 

GOTO 717 

715 T I I » ST ( NROW+1 , LL ) 

TIK = T 1 1 
TOK = TII 

too => tii 

717 TEMPI = ALPHTH*XNUTP*ALPHPH 
TEMP2 = ALPHPH+XNUPT*ALPHTH 
TEHP3 =» 1-XNUPT*XNUTP 
TEMP4 » H 1/4.0 

ETHK1 = ETHET*TEMP1/TEMP3 
TEMP5 = HI**2/24.0 
TEMP61= TII+ TIK-2* TEFREE 
TEMP62= TOO* TOK-2* TEFREE 
TEMP71= 2.0* TII +TIK-3*TEFREE 
. TEMP72= 2.0* TOO *T0K-3*TEFREE 
EPHK1 = EPHI*TEMP2/T£MP3 
GO TO (811, 812, 813, 8141, THICK 


814 GO TO (815, 811, 815, 811, 812, 813, 811, 812, 813, 811, 812,813), ISTTAB 


811 


812 


* 

* 

*. 

* 


TEMP4 

TEMP4 

TEMP5 

TEMP5 


(TEMP61* TEMP62 ) 
(TEMP61 * TEMP62) 
(TEMP71- TEMP72) 

( TEMP71 - TEMP72 ) 


813 


816 


817 


818 


XNTTH* ETHK1 
XNTPH* EPHK1 
XMTTH= ETHK1 
XMTPH= EPHK1 
GO TO 816 
T I - T/2.0 
TEMP8* HI/2.0 

XNTTH = ETHK1*TEMP8*(TEMP61*TEMP62> ' 

XNTPH = EPHK1*TEMP8*(TEMP61+TEMP62> 

XMTTH = ETHK 1*T EM P8*(HI*(TEMP 71-TEMP 72)/3.0+TI* ( TEMP61-TENP62 ) ) 
XMTPH = EPHK1*TEHP8*( HI* ( TEHP7 1-TEMP72 )/3.0+TI*( TEMP61-TEMP62 ) ) 

GO TO 816 ^ . 

T I * (HO**2-HI**2+2.0*HO*T1/(2.0*(HI*HO) ) 

TO = ( H I **2-H0**2*2 .0*H I*T ) / ( 2 .0*( HI.+HO ) ) 

XNTTH = ETHK 1/2. 0*( HI*TEMP61*H0*TEMP62 ) • 

XNTPH = EPHK1/2.0*(HI*TEHP61+H0*TEMP62> 

XMTTH * ETHK 1/2 .0*( HI **2*TEMP71/3 .0-HO**2*TEMP72/3.0*TI *HI*TEMP61- 
1 TO*HO*TEMP62 ) 

XMTPH = EPHK 1/2 .0*( HI**2*TEMP71/3.0-HO**2*TEMP72/3.0+TI*HI*TEMP61- 
1 TO*HO*TEMP62 ) 

CONTINUE 

IF ( ISTTAB. EO. 2) GO TO 714 
GO TO (817,818,819),KLUE2 
XNTPH = XNT PH+ES*APH/SPH*ALPHS*TS 
XNTTH = XNTTH+ER*ATH/STH*ALPHR*TR 
XMTPH = XMTPH+CPH*ES*APH/SPH*ALPHS*TS 
XMTTH = XMTTH+CTH*ER*ATH/STH*ALPHR*TR 
GO TO 714 . . . . 

TEM = ES*APH/SPH*ALPHS*TS 
XNTPH = XNTPH+TEM 
XNTTH = XNTTH+TEM 
XMTPH = XMTPH*CPH*TEM 
XMTTH = XMTTH+CPH*TEM 
GO TO 714 


2204860 

2204870 

2204880 

2204890 

2204900 

2204910 

2204920 

2204930 

2204940 

2204950 

2204960 

2204970 

2204980 

2204990 

2205000 

2205010 

2205020 

2205030 

2205040 

2205050 

221(5060 

2205070 

2205080 

2205090 

2205100 

2205110 

2205120 

2205130 

2205140 

2205150 

2205160 

2205170 

2205180 

2205190 

2205200 

2205210 

2205220 

2205230 

2205240 

2205250 

2205260 

2205270 

2205280 

2205290 

2205300 

2205310 

2205320 

2205330 

2205340 

2205350 

2205360 

2205370 

2205380 

2205390 

2205400 

2205410 

2205420 

2205430 

2205440 

2205450 

2205460 
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819 TEH = ES*APH/SPH*ALPHS*TS 2205470 

XNTPH 3 XNTPH+TEH*CS8/SNB 2205480 

XNTTH - XNTTH*TEM*( 1.0+SNB) /CSB 2205490 

XMTPH = XMTPH+CPH*TEM*CSB/SNB 2205500 

XHTTH •'* XMTTH+CPH*TEH*( 1.0+SNB) /CSB 2205510 

GO TO 714 2205520 

815 TEMP10 = ( (-XKU*XDll)**.5>/<48.0**.5) 2205530 

TEM11 ={ (-XK22*X022»**.5)/<48.0**.5) 2205540 

XNTTH = XK11/4.0*TEMP1*(TEHP61*TEMP621 2205550 

XNTPH * XK22/4.0*TEMP2*< TEHP6 1+TEHP62 ) 2205560 

XHTTH = TEMP10*TEMP1*(TEMP71-TENP72) 2205570 

XHTPH = TEH11*TEHP2*< TEHP71-TEMP72 ) 2205580 

714 CONTINUE 2205590 

8889 RETURN 2205600 

ENO 2205610 
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FOR, IS TEMOEG,TEMOEG 

SUBROUTINE TEMOEG 

THIS SUBROUTINE CALCULATES THE GEOMETRY FOR A SHELL SEGMENT. 

THE INPUT VARIABLES ARE . . . 

Rid) DISTANCE FROM AXIS OF REV. TO POINTS 

ON SHELL MERIDIAN. 

ZIIII DISTANCE ALONG AXIS OF REV. TO THE 

INTERSECTION OF THE CORRESPONDING R I ( I ) AND 
THE AXIS OF REV. 

NRZIN NUMBER OF (RI.ZI) PAIRS READ AS INPUT. 

COMMON /SNILPS/ ANG.PS II 100 1 *RAD( 100 1 ,CURi< 100) ,CUR2 C 100 ) t 
1 DR1DP(100),ZI<14),RI(14), NRZIN 

DIMENSION Cl t 4, 13 ) , DROZ ( 14 1 , SOUT 1 14 ) ,S 1 101 ) , RADDI 100 I 

FUN(ARG) = SORT (1.0 ♦ ARG**2) 

RADS * 3. 1415926/180.0 
DATA B/'B '/ 

AMULT =1.0 

IF (ANG.EQ.B) AMULT = -1.0 

PASS SPLINE CURVE THROUGH INPUT POINTS ON SHELL MERIDIAN, AND 
COMPUTE DR/OZ AT THESE POINTS. 

CALL PLYCO (ZI, RI, NRZIN, Cl ) 

NDELZ = NRZIN - 1 
DO 60 1=1, NRZIN 

CALL PLYNE ( Z I , R I ,NRZ IN ,CI , ZI (I) ,FAKE1 ,0RD2 ( I ) , FAKE2 ) 

60 CONTINUE 

COMPUTE MER IOIONAL ARC LENGTH TO INTERPOLATED POINTS BY 
NUMERICAL INTEGRATION I SIMPSONS RULE) . SINCE SIMPSONS RULE 
REQUIRES AN EVEN NUMBER OF PARTITIONS, INTERPOLATE A POINT 
HI OH AY BETWEEN EACH PAIR OF POINTS USING SUBROUTINE PLINE. 

SOUTH) = 0. 

DO 70 1=1, NDELZ 
DZ2=(zimn-zi(in/2.o 
DZ6=0Z2/3.0 

CALL PLYNE ( Z I, R I ,NRZ IN, C I ,Z I (I) ♦DZ2.FAKE1 ,DRDZM,FAKE2 ) 

SOUT ( 1*1 ) = SOUT ( I ) ♦ 0Z6* ( FUN < OROZ ( I ) ) ♦ 4. 0*FUN< DRDZM) ♦ 

1 FUNIOROZI 1*1) ) ) 

70 CONTINUE 

USE SPLICO TO REPRESENT RI(I) AS A FUNCTION OF SQUTI I ) . THEN USE 
SPLINE TO INTERPOLATE RADD AND CORRESPONDING DERIVATIVES. FROM 
THESE, COMPUTE THE THO PRINCIPAL RADII OF CURVATURE, 

CUR1 = 1/R1 
CUR2 = 1/R2 

0L0H1 = SOUT (NRZINJ/99.0 
CALL PLYCO (SOUT, RI, NRZIN, Cl) 

00 110 1=1,100 
Sill = FLOAT (1-1 )*OLDHl 

CALL PLYNE ( SOUT , RI ,NRZ IN ,C I, S ( I ) ,RAO( I ) ,RAD0( I ) ,RAD02 ) 

IF (ABS(RAOD(D).GT.l.O) RADD(I) = 1.0 
FACTOR = $QRT( 1.0-RA00( I )**2) 

CURl(I) = -RA002/FACT0R 
CUR2(I) = FACTOR/RAOt I ) 
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110 

CONTINUE 

2600600 


00 180 J=l,100 

2600610 


COSPSI = AMULT *RADO ( J ) 

2600620 


PSKJ) = ARCOS ( COSPSI > 

2600630 


SINPSI = -AHULT*RADI J )*CUR2 ( J ) 

2600640 


IF (ANG.EQ.8) GO TO 179 

2600650 


PSKJ) = 2 .0*3. 1415926-P S I ( J i 

2600660 

179 

CONTINUE 

2600670 


CUR1IJI .« -AMULT/CURK J) 

2600680 


CUR2CJ) = -AMULT/CUR2U) 

2600690 


IF (J.EQ.l) GO TO 180 

2600700 


1*1 

2600710 


IF (J.EQ.2) GO TO 181 

2600720 


I = 2 

2600730 

181 

IF (ANG.EQ.B) GO TO 190 

2600740 


DR1DPU-1) = (CUR1( J I-CURl ( J- I )) / < PS I ( J )-PSl ( J- 1 ) ) 

2600750 


GO TO 180 

2600760 

190 

DRlDP(J-l) = (CURK J-IJ-CURl(J) J / ( PS I ( J-I )-PSI I J ) ) 

2600770 

180 

CONTINUE 

2600780 


ORIDP(IOO) = OR 10P( 99 ) 

2600790 


00 42 J= 1,100 

2600800 


/OR 10P ( j I = DR1DP( J ) *0. 1 

2600810 

42 

CONTINUE 

2600820 


RETURN 

2600830 


END 

2600840 
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FOR, IS PLYCO » PLYCO 

SUBROUTINE PLYCO IX,Y,M,CJ 

C SUBROUTINE TO DETERMINE C ( 1,K ) ,C { 2, K » ,C ( 3,K ) AND CIA K). 
DIMENSION XIlA),YnA),AllA»3)*BIlA),ZnA) 

DIMENSION D( 13),P(13),E< 13), CIA, 13) 

MM = M-l 

DO 10 K= 1 , MM 

OIK) * XlK+l) - X IK ) 

PIK) = 0IKI/6.0 
10 EIK) = I YIK+D-YIK) l/DIK) 

00 20 K=2, MM 
20 BIK) = EIK) - EIK-1) 

AH, 2) = -1.0-DI 1)/DI2) 

AH, 3) = 0ID/DI2) 

A 1 2,3 ) = PI2 )— PI 1 )*AI 1, 3 ) 

Al 2, 2 ) = 2 .0*1 PI1I+PI2)) - PI 1 )*A(1,2) 

AI2.3) = AI2,3)/A( 2,2 ) 

B 1 2 > * B I 2 ) / A( 2 , 2 ) 

DO 30 K=3»MM 

AIK, 2) = 2.0*IPIK-1)*PIK))-PIK-1)*AIK-1,3) 

BIK) = BIK)-PIK-l)*BIK-l) 

AIK, 3) = PIK )/At K, 2 ) 

30 BIK) = BIK)/ AIK, 2) 

0 = DIM-21/DIM-1) 

AIM.l) = l.O+Q+AIM-2,3) 

AIM, 2) = -Q-AIH, 1)*AIM-1,3) 

BIM) = B I M-2 )-AIM»l)*BIM-l) 

ZIM) = B I M )/ AIM, 2 ) 

MN = M-2 
DO AO 1*1, MN 
K = M— I 

AO Z I K) * BIK)-AIK,3)*ZIKH> 

111) = -Atl,2)*ZI2)-Atl,3)*ZI3) 

DO 50 K=1,MM 
Q * 1 . 0 / 1 6 . 0 * 01 K ) ) 

C I 1,K) = ZIK)*Q 

C I 2,K ) = Z I K+l I *0 

C I 3 , K ) = YIK)/0IK)-Z1K)*PIK) 

50 C I A, K ) = YIK*1)/0(K)-Z1K + 1)«PIK) 

RETURN 

END 
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o n o o o 


FOR, IS PLYNE* PLYNE 

SUBROUTINE PLYNE ( X , Y.N, C , XINT, YI NT,OYOX,D2 YDX2 ) 

SUBROUTINE FOR SPLINE FIT INTERPOLATION IN THE TABLE OF VALUES 
(XI, Yl) TO (XN.YN), WHERE M MAY BE AS LARGE AS 100, HERE THE 
CONSTANTS C(1,K)«C(2*K),C(3*K) AND C(4,K) ARE ALREAD COMPUTED 
ANO STORED. 

SUBROUTINE ALSO COMPUTES OY/OX AND D2Y/0X2 AT XINT. 

DIMENSION X( 14), Y( 14),C(4,13) 

IF (XINT-XUI) 80,10,20 
10 YINT = Y(l) 

K=1 

GO TO 70 
20 K « 1 

30 IF (XINT-XIK+ll) 60,40,50 
40 YINT = YIK + l ) 

GO TO 70 
50 K = K ♦ 1 

IF (M-K) 80,80,30 

60 YINT = (X(K+1) - XINT)*(C( 1 ,K )*( X (K* l )-X INT >**2*C ( 3, K ) ) 

YINT = YINT ♦ (XINT-X(K))*(Ct2»K>*(XINT-X(K> )**2-*C 14 »K) ) 

70 0Y0X»-3.0*(C(1,K)*(X(K+1»-XINT)**2-C(2,K>*(XINT-X(K) )**2) 

1 -C(3,K)*C(4,K) 

D2YDX2 = 6.0*(C(1,K »* ( X ( K* 1 )-X INT 1 +C { 2,K ) ♦ ( XI NT-X ( K ) )) 

RETURN 

80 WRITE (6,90) 

90 FORMAT (31H OUT OF RANGE FOR INTERPOLATION) 

RETURN 
END 
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FOR. IS GRAPH, GRAPH 

SUBROUTINE GRAPH (KGEOH) 

COMMON /GRAF IX/ XI 100 1 • Y 1 100, 9 ) .NGRAPH.LOEF I 9) ,NGR , JCYC.NFLAG, JAM, 
C JNSC 

COMMON /COISP/ P 

DIMENSION IDARYI22) .YTITLEI 12),YTITI 4,9) .XTITLEt 12) 

01 MENS ION TITLE! 12), ALPHA! 2) 

DATA YTITLE/12*' •/ 

DATA TITLE/'REGION' ,' NO.” *,2*6H , 'SEGMEN* , *T N0.»', 

I 2*6H ,' CYCLE *,'N0.= ',2*6H / 

DATA YTIT/'U ',3*' •, 

1 'V ',3** '. 

2 *N ',3*' ', 

3 'SIGMA ', 'THETA • , • IN ',' ', 

4 'SIGMA • » • PHI IN',' ',' ', 

5 'TAU PH', 'I THET'.'A IN »,' ', 

6 'SIGMA ', 'THETA '.'OUT ',' ', 

7 'SIGMA ','PHI OU'.'T »,' ', 

8 'TAU PH', 'I THET','A OUT ',' •/ 

DATA XTITLE/'OISTAN'.'CE ALO'.'NG SEG', 'MENT !•/ 

DATA A/ • PHI ) •/, B/ • S I •/ 

EXTERNAL TABLIV 
IF INFLAG. NE.OJ GO TO 1 
CALL IDENT I9,I0ARYI 
NFLAG = 1 
1 CONTINUE 

CALL CHS IZV (2,2) 

CALL RITSTV ! 13 , 19, TABL IV ) 

XMN = X! 1) 

XMX = XU) 

DO 20 J= l » JCYC 

IF !X ! J ) . LT.XMN) XMN = X(J) 

IF IXIJI.GT.XMX) XMX * XU) 

20 CONTINUE 

CALL SCRNO 1 XMX ,XMN,XMAX,XM IN ) 

INOEX = 0 
DO 100 K=i,9 

IF ILOEFIK) .EQ.O ) GO TO 100 
INDEX = 1NDEX+1 
YMN = Y! 1, INOEX) 

YMX = Yil, INDEX) 

DO 30 L=1,JCYC 

IF (YIL, INDEXI.LT. YMN) YMN = YIL, INDEX) 

IF I YIL, INOEX). GT. YMX) YMX = YIL, INDEX) 

30 CONTINUE 

CALL SCRND ( YMX, YMN, YMAX.YMIN ) 

IF I KGE0M.EQ.3.0R.KGE0M.EQ.4) GO TO 1234 
XTITLEI5) = A 
GO TO 1235 

1234 XTITLEI 5 ) * B 

1235 CONTINUE 

DO 45 M=l,4 

45 YTITLE(M) = YTITIM.K) 

CALL QUIK3L (-1 , XMI N, XMAX, YMIN, YMAX, 1H* * XT ITLE , YTITLE ,-JCVC ,X, 

1 Yil, INDEX)) 

ENCODE (801, ALPHA) JAM, JNSC 
801 FORMAT 1216) 

TITLEI3) = ALPHA! 1 ) 

TIJTLEI7) ■ ALPHA! 2 ) 

KCYC = P 
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ENCODE (802, ALPHA) KCYC 
802 FORMAT (16) 

TITLEU1 ) = ALPHA(l) 

CALL RITE2V ( 46, 1005, 1023, 90 , 1 , 72 , 1 , TITLE , IERR ) 

IF ( IERR.NE.0 ) WR IT E ( 6 , 800 ) IERR 

800 FORMAT ( 1 IERR =«,I3,‘ CHARACTER COUNT WHERE WRITING WAS STOPPED') 
100 CONTINUE 
RETURN 
END 



SUBROUTINES ODEI AND 0DE2 


Subroutine LEBEGE calls either ODEI or 0DE2, as necessary, and various 
geometric and trigonometric clues , as well as the predicted values of the 
variables for the differential equations, are passed to this subprogram 
via label common area LASTEQ. 

The equations in ODEI and 0DE2 are identical to those in subroutines DIF1 
and DIEF2 respectively. Subroutines ODEI and 0DE2 perform the final 
integration for each segment in the structure utilizing the initial conditions 
previously obtained, and return these values to LEBEGE via label common 
area LASTEQ. 


The ODEI, 0DE2 flow charts are identical to the DIP1, DIET2 flow charts 
respectively. 
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FORTRAN CODE 


ENGINEERING SYMBOLS (REF. 1 


YANPT 

YAQPH 

YAQTH 

YAOPH 


4>e 


% 

Q n 


) 
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FOR. IS ODEl.OOEl 

SUBROUTINE ODE1 
INTEGER SAVJTC,SAVSTP,Q, THICK 
INTEGER XNl.XN 
REAL K 

DOUBLE PRECISION YPREO 

COMMON STORY ( 16 I.XMATI 270,10). STDI 10 ) , SADUS ( 30) ,RADUS(30) 

COMMON TADUS (30 ) .UADUSC 30 ) , SAVTIC ( 900 ) 

COMMON XN, TEFREE, TIC, PHI, STOP, RESTOP, RTICK.Gl , XNL (3) ,NH 
COMMON NST C 30 ) , NKL( 30 ) , NXMAT ( 20) , SAVJTC ( 30) , SAVSTP 13 0) ,JRTIC(30) 
COMMON JRST0P(30),NREG,NHPT,NRC,NSC»NIX,I ERROR, KGECtfl , IGEOM , I STTAB 
COMMON KELVIN, IBEGIN,NPROB,NSEG,NERROR,Q, THICK, NOJS, NLINKS .NLCASE 
COMMON NTSKL ,NZ,NBCT,L INPUT, NTRKL ,NPASS , XN1 ,KBC .NRINGS 
COMMON LODE, ICYCLE.LDISTL 

COMMON /LASTEQ/ YPREOI 8 ) , YOOT I 8) , YASAVE ( 8 ) , 

1 YANTH,YAMTH,YAMPT,YANPT,YAOPH,YAQPH, YAQTH.YAJPH, 

2 S,SN,CS,SNSQ»CSSQ,TAN,SEC,CN-,XiCS,XLSN»TN, 

3 X 1R0, X 1R0SQ.X 1SNR0, X 1CSR0.CN1R0, SN.IR 0.CS1R0 , 

4 X1R1,X1R2,CS1R1,CS1R2,SN1R1,X1R1 SO, R2SQ.R0, BE SQ, 

5 ROSQ»XNSO,BETA,R1,R2,S1,R1DOT,R1SQ, 

6 XNTTH,XNTPH,XMTTH,XMTPH,XFTHLD,XFPHLD,XFZELD, 

7 XMTHLD, XMPHLD,ETHET,EPHI,XGPT ,ALPHTH , ALPHPH , 

8 XNUTP,XNUPT,XCli,XC22,XC15,XD33,XD22 ,XD21,XD12, 

9 XK11,XK12,XK21,XK22,XK33,XD11, 

A M, I.SITIN.SITOUT, SIP IN, SI POUT ,TPTIN,TPT0UT, 

B ZBRIN.ZBROUT, SCR IPA.SCRIPI.SIFIN, SIFOUT , TZEPH, TZETH 

B ,XNPHI,BETTA,ZETTA,XC16 

C , RMOSS, RMOSN, YLDST ,ROC,HP,FPLUH,GPLUH,TWON 

D ,RMOSSY, RMOSN Y .RMOSXY.RMONXY 

D , RMOSNS , RMOSS S , S 1 GOX S , RHOSNR , RMOSSR, S I GOXR 

COMMON /PLS/ OMEGA, INORD.XMERD.XPRES.XMONT 

COMMON /HOOD/ SAVY ( 53 ) , NPLE V.NLPO , NPLA ( 21 ) , STR I 6 ) . SI GMA 1 3,21 ) , 

C SEPSI3,2l),SALPH(3,21),SBAPH(3,21),STEPS(3,2l), 

0 EFF(2l)»$TSRN(3)*NPLAST(3)»STSIG(3)»STREPSI3) , 

M STALPH(3),STBAPH(3)»EFFSTI3),NPLEVS(3) 

COMMON /CDISP/ P,PMAX,DELP,DELP1,YEPS,ZEPS 
EQUIVALENCE ( XNL (1) , X 1 ) , ( XNL ( 2 ) , X2 ) , ( XNL ( 3 ) , X3 > , (K.DELP) 

IF I ISTTAB.NE.2) GO TO 7786 
: THE FOLLOWING EQUATIONS ARE THE 'THICK* SET 

GO TO (151,152, 153), IGEOM 

: EQUATIONS FOR SHELLS OF REVOLUTION ( PHI COORDINATE ) 
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CONTINUE 
YAOPH 
YANTH = 


= XN*YPRED( 1+6 )*X1R0-YPRED( 1+4 )*SN1R0 

XNUPT *YPRED( 1 + 1 ) + ( XK 1 1-XNUPT**2* XK22 )* ( ( XN*YPRED I 1+4 )♦ 

1 YPREOI I+5)*CS-YPRED( 1+6 )*SN ) *X1R0+X1*YA0PH*S AVY (9 ) )+K* 

2 ( XNUPT* XNTPH-XNTTH )+X2*( XNUPT* SAVY 1 1 1 )-S AVYI 10) ) 

3 +X3*S AVY ( 43 ) 

YAMTH = XNUPT* YPREDI 1+3 )- ( XD 1 1-XNUP T**2* XD22)*X1R0*IX1R0*(XN* 

1 YPREOI I+4)*SN-XNSQ*YPRED( 1+6) )+YPRED< 1+7 )*CS)+K* 

2 I XNUPT *XMTPH-XMTTH )+X2* I XNUPT* SAVY 1 14) -S AVY 1 13 ) ) 

3 +X3*S AVY 1 49 ) 

YAMPT = 1-1. 0/1 (R0/XD33)+(SNSQ*X1R0/XK33)) )*(-2.0*XN* 

1 YPREDlI+7)+YPRED(I+4)*ICSlR 1-CN1R0 ) +XN*YPRED 11 +5 )* 

2 (SN1R0+X1R1 ) +2. 0*XN*YPRED 1 1 +6) *C S1R0+YPR ED 1 1 ) *SN/ 

3 XK33+X2*(SAVY(12)*SN/XK33-SAVY(15)*R0/XD33 )+SN*Xl* 

4 IYAOPH*SAVY( 5 ) +SAVYI 9 )*YPRED 1 1 + 7) ) ) 

5 +X3*$AVY( 50 ) 

YANPT = YPREDI I 1+YAMPT*SN1R0 

YAJPH * YPRED(I+2)+Xl*(SAVY(8)*YA0PH+YANPT*SAVY(9)-YPRED(I+l) 

1 *S AVY (5)-YPRED( I+7)*SAVY(6) ) 

YOOT I I+A) = Rl* I YPREDI I +4 )*CS1R0+XN*YPRED 1 1 +5 ) *XIR0+ YPREDI I ) /XK33+ 
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2000020 

2000030 
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2000050 
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2000070 
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2000100 

2000110 

2000120 

2000130 

2000140 

2000150 

2000160 

2000170 

2000180 

2000190 

2000200 

2000210 

2000220 

2000230 

2000240 

2000250 

2000260 

2000270 

2000280 

2000290 

2000300 

2000310 

2000320 

2000330 

2000340 

2000350 

2000360 

2000370 

2000380 

2000390 

2000400 

2000410 

2000420 

2000430 

2000440 

2000450 

2000460 

2000470 

2000480 

2000490 

2000500 

2000510 

2000520 

2000530 

2000540 

2000550 

2000560 

2000570 

2000580 

2000590 

2000600 
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1 

2 

3 

YOOT ( 1 + 5 ) 

1 

2 

3 

A = 

1 

B = 

1 

YDOTII > 

1 

2 

3 

4 

5 

YOOT ( I + l ) 

1 

2 

3 

4 

YOOT ( 1+2) 

1 

2 

3 

4 

5 

YDOT(I+3) 

1 

2 

YOOT (1+6) 
YDOT ( 1+7) 

1 

2 
3 


X2*S AVY (12)/XK33+YANPT*SN1R0/XK33)+R1*X1*( YAOPH* 
SAVY(5)+YPR£Dd+7)*SAVY(9) ) 

+X3*SAVY( 51 ) 

Rl*( YPR£D( I + 6)*XlRl+d.0/(XK22-XNUTP**2*XKll)>* 

( YPRED< I+l ) -XNUTP*Y ANTH+K* I XNTPH— XNUTP*XNTTH )+X2* 
<SAVY(li)-XNUTP*SAVY( 10) ) ) )-Rl*YPRED( 1+7 )*X1*SAVY(5) 
+X3*SAVY( 52) 

YPREO( I+5)*CSIR0-YPRED( 1+6 )*SN1R0+SAVY(9 )*YAOPH+ 

YOOT( I+5)/Rl-YPRED( 1+6) /Rl+SAVY ( 5)*YPRED ( 1+7 ) 

SAVY ( 1 ) *C'S 1R0-SAVY(3)*SN1R0+.5*(SAVY(9)*SAVY(9) 
♦SAVY(5)*SAVY(5))+(SAVY(2)-SAVY(3) )/Rl 
R1*(-2.0*YPRED( I)*CS1R0+XN*YANTH*X1R0-XN*YAMTH*SN* 
X1ROSQ-Y AMPT*CS 1RO* l X 1R1-SN1R0 ) )-Rl*K* (XFTHLD+XMPHLD*. 
SN1R0)-R1*X1*(SAVY( 24 )*A+K*XFTHLD*B+SAVY (25 ) *YDOT (1+4) 
/R1+SAVY(4)*K*XFPHLD/R1+SAVY(26) ♦YAOPH+S AVY ( 9) *K* 

XFZ ELO+SN/RO* ( YANTH*SAVY( 9 ) +YADPH*SAVY (7 )- YPRED ( 1+7 )* 
SAVY ( 8 )-YANPT*SAVY (5)))-X3*SAVY(33) 

R1*(CS1R0*( YANTH-YPRED( t+1) )-XN*XiRO*( YPREOd )* 

YAMPT *( SN*X 1R0+X 1R 1 ) )+YPRED ( 1 + 2 ) *X1R1 )-R 1*K*XFPHLD 
-R1*X1*(SAVY (.25 )*A+K*XFPHLD*B 
-SAVY<26)*YPRE0(I+7)-SAVY(5)*K*XFZELD) 

-X3*SAVY( 34 ) 

R1*(-YPR£D( I+2)*CS1R0-YANTH*SN1R0-YPRED( I+1)*X1R1 
+XNSQ*YAMTH*XlR0SQ-2 . 0*XN*YAHPT*CS*X1ROSQ)+R1*K* 
(XN*XMPHLD*X 1R0-XFZELD1-R 1*X 1* ( SAVY ( 26 )* A+K*XFZELD* 

B-S AVY ( 24 )*Y AOPH— SAVY ( 9)*K* 

XFTHLD+SAVYt 25)*YPRED< 1+7 ) +SAVY ( 5 ) *K*XFPHLD) 

-X3*S AV Y( 35 ) 

Rl*( YAHTH+CS 1R0-YPRED(I+3)*C S1RG-2. 0*XN* YAMPT*X1R0+ 
YAJPH+K*XMTHLD) 

♦X3*SAVY ( 36 ) 

Rl*(YPRE0(I+7)-YPRE0( I+5)*XIR1) 

Rl*( 1.0/(XD22-XNUTP**2*XDll) )* (- YPRED( 1+ 3) +XNUTP* 
YAHTH-K* ( XMTPH— XNUTP*XMTTH) — X2* (SAVY(14)-XNUTP* 

SAVY ( 13)) ) 

♦X3+SAVY ( 53 ) 
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GOTO 9005 
EQUATIONS 
CONTINUE 
YAOPH 
YANTH = 


FOR CONE 


■ XN*YPREO( (+6 )*X1CS/S-YPRED(I+4)*TAN/S 
XNUPT*YPREO( I+l)+(XKll-XNUPT**2*XK22)*(< X1CS/S)*(XN* 

1 YPRED< 1+4 )+YPRED( I +5 ) *CS-YPRED ( I +6 ) *SN) + X1*YA0PH* 

2 SAVY ( 9 ) I +K* l XNUPT + XNTPH-XNTTH ) +X2* ( XNUPT *SAVY(ll)— 

3 SAVY (10 I) 

4 +X3*SAVY( 48 > 

YAMTH=XNUPT*YPRED( I +3 )-( 1 . 0/S ) *X 1C S* ( XD1 1-XNUPT**2*XD22 ) * ( ( 1 -0/S )* 

1 XICS*( XN*YPREO( X+4 ) *SN-XNSQ*YPRED ( 1+6) )+YPRE0( I+7)*CS)~ 

2 K*( XMTTH— XNUPT*XMTPH) 

3 +X2*(XNUPT*SAVY(14)-SAVY(13) > 

4 +X3*S AVY( 49 ) 

YAHPT=(-1.0/( (S*CS/X033)+(SN*TN/(XK33*S) >> )*(-2.0*XN*YPRED ( I+7>- 
1 YPRED( I+4)*SN/S+XN*YPRED( I+5)*TN/S+2.0*XN*YPRED( I+6)/S+YPRE0 


2 

3 

4 

5 


YANPT 
YAJPH = 


( I ) *SN/XK33+X2*( SAVY 1 12 ) *SN/XK33-SAVY 1 15 >*S*CS/XD33) 
+SN*X1*( YAOPH* 

SAVY(5)+SAVY(9)*YPRED( 1+7) ) ) 

♦X3*SAVY( 50) 

YPREOd ) +YAMPT*TAN/S 

YPRED(I+2)+Xl*(SAVY(8)*YA0PH+YANPT*SAVY( 9) -YPREO (1+1 )* 


1 SAVY(5)-YPRE0( I+7)*SAVY(6) ) 

YOOT ( 1+4 ) = ( 1 .0/S ) *( YPRED( I +4 ) +XN* YPREO ( I+5)*X1CS+ YANPT +TN/XK33 ) 
1 +YPRED( I )/XK33+X2*SAVY( 12 ) /XK33+X1* ( YAOPH*SAVY ( 5> ) 
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2000620 

2000630 

2000640 

2000650 
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2000670 

2000680 
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2000700 

2000710 

2000720 

2000730 

2000740 

2000750 

2000760 

2000770 

2000780 

2000790 

2000800 

2000810 

2000820 

2000830 

2000840 

2000850 

2000860 

2000870 

2000880 

2000890 

2000900 

2000910 

2000920 

2000930 

2000940 

2000950 

2000960 

2000970 

2000980 

2000990 

2001000 

2001010 

2001020 

2001030 

2001040 

2001050 

2001060 
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2001080 

2001090 

2001100 

2001110 
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2001150 
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2001170 
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2001190 

2001200 

2001210 
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1 

1 

2 

3 

4 

5 

1 

2 

3 

\ 

1 

2 

3 

4 

1 

1 

2 


♦YPREDl 1+7 )*SAVY1 9 ) ) 

♦X3*SAVY(51) 

YD0T1I+5) = ( 1.0/ ( XK22-XNUTP**2*XK1 1 ) > * t YPREDl I +1 ) -X NUTP*Y ANTH+ 
K*<XNTPH-XNUTP*XNTTHJ+X2*ISAVY( 1 1 >-XNUTP*SAVY( 10 > ) » 
-YPREDl l+7)*Xl*SAVY(5l 
♦X3*SAVYI52) 

A = YPREDl I +5 l/S-YPRED 1 1 +6 ) *TN/ S+SA VY 1 9) *YA0PH+YD0T 1 1+5) 

L +SAVY(5)*YPRE0I 1+7) 

B = SAVY<1)/S-SAVY<3)*TN/S+0.5*(SAVY(9)*SAVYC9)+SAVY(5)* 

SAVYI5) )+SAVY<2) 

YDOT ( I ) =-2.0*YPRE0I I I/S+XN*YANTH*X1CS/S-XN*YAHTH*SN*X1CS**2/S**2 

♦YAMPT*TAN/S**2-K*( XFTHLD+XMPHLD+TAN/S )-Xl*(SAVYI24)* 
A+K*XFTHLD*B+SAVY< 25I*YD0T( 1+4 ) +SAVY I 4)*K*XF PHLD+ 

SAVYI 26)*YA0PH+SAVYI9)*K*XFZELD+TAN/S*1YANTH*SAVY(9>+ 
YA0PH*SAVY(7)-YPRED( 1+7 ) +SAVYI 8 ) -YANPT*S AVYl 5 ) ) >-X3* 
SAVYI33) 

YDOT (1+1)= — YPREO( I+l)/S+YANTH/S-XN*YPRED(l)/IS*CS)- XN*YAMPT*SN/ 

( S*S*CS*CS )-K*XFPHLD-Xl* (SAVY 12 5 ) *A+K*XF PHLD+B- 
SAVY (26)*YPR£D( 1 + 7 ) -SAVY 1 5 > *K*XFZELD ) 

-X3*S AVY ( 341 

YDOT ( 1+2 ) = -YPRED( 1+2 > /S-YANTH+TAN/S+ XNSQ* YAHTH/ I S**2*CS**2 ) 

-2.0*XN*YAMPT/IS**2*CS)+K*1XN*XHPHLD*X 1CS/S-XFZELD) 
-X1*($AVY(26 l*A+K*XF ZELD+B- SAVY I 24 ) * YAOPH- SAVY 19)*K* 
XFTHLD+SAVYI 25)*YPRED( 1+7) ♦ SAVY ( 5 ) +K+XFPHLD) 

-X3+SAVY ( 35 ) 

YDOT II +3 )= Y AMTH/S-YPREDI 1 + 3 )/ S-2.0*XN*YAMPT/ ( S*CS > + YA JPH+XHTHLD 
♦K 

+X3*S AVY ( 36 ) 

YDOT t 1+6 >=YPRED( X+7 ) 

YDOT ( 1+7 1=1 1.0/(XD22-XNUTP**2*XD11))*(- YPREDl 1+3 >+XNUTP*YAMTH- 

1 K*IXMTPH-XNUTP*XMTTH)-X2*f SAVYI 14 )-XNUTP*SAVY( 13 ) ) ) 

2 +X3*S AVY I 53 ) 

GO TO 9005 

EQUATIONS FOR CYLINDER 
153 CONTINUE 

YAOPH = XIRO*(XN+YPRED( I + 6I-YPREDI 1 + 4) ) 

YANTH = XNUPT+YPREDI l + l 1 + I XK1 l-XNUPT**2*XK22) * 1 1 XIRO+IXN* 

1 YPREDl I+41-YPRE0I 1+6) ) )+Xl* YAOPH+SAVY ( 9) )+K*lXNUPT* 

2 XNTPH-XNTTH)+X2*(XNUPT*SAVY( U)-SAVY(IO) ) 

3 +X3+SAV Y ( 48 ) 

YAMTH=XNUPT<'YPRED(I+3)-(XlR0*I XD11-XNUPT**2*XD22 ) ) *( X1R0+I XN+YPRED 

1 ( 1+4 >-XNSQ*YPRED( 1 + 6 ) ) 1 +K* ( XNUPT+XMTPH-XMTTH ) 

2 +X2*(XNUPT*SAVY( 14)-SAVY(13) ) 

3 +X3+SAVYI49J 

YAMPT=l-1.0/< (R0/XD33 ) + ( X 1R0/XK 33 ) ) )*( -2.0*XN*YPREDl 1 + 7 ) +XN+XIRO* 

1 YPREDl 1+5 l+YPREDI I ) /XK33+X2* I SA VYI 12 ) /XK33-S AVYU5 ) * 

2 R0/XD33)+Xl*(YA0PH*SAVY(5) + SAVY(9)*YPREDU+7) ) ) 

3 +X3+SAVYI 50 ) 

YANPT = YPREDl I ) +YAMPT+X1R0 

YAJPH = YPRED(I+2)+Xl*(SAVY(8)*YA0PH+YANPT*SAVYI9)-YPREDII+l) 

1 *SAVY(5)-YPRED( I+7)*SAVY16> ) 

YDOT ( 1+4 ) = XN*YPREDl I+5)*X1R0+YPRED(I >/XK33+X2*SAVY (12>/XK33+ 

1 YAMPT*X1R0/XK33+X1*(YA0PH*SAVY(5)+YPREDI I+7)*SAVY<9) ) 

2 +X3+SAVYI 51 ) 

YDOT ( 1 + 5 ) = (1.0/<XK22-XNUTP**2*XKim*(YPREDCI+l)-XNUTP*YANTH+ 

1 K*( XNTPH-XNUTP+XNTTH ) +X2* ( SA VYl 1 1 ) -XNUTP *S AVY110 ) ) >- 

2 YPRE01I+7)*X1*SAVY(5) 

3 +X3*S AVYI 52 I 

A = -YPREDl I+6I/R0+SAVY(9)*YA0PH+ YD 0T(I+5)+SAVY(5)* 

l YPREDl I +7 ) 

B = -SAVY(3)/R0+0.5*<SAVY(9)*SAVY(9)+SAVY15)*SAVY(5) >+ 
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2001600 
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2001740 
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2001800 

2001810 

2001820 


V, 



1 SAVY ( 2 ) 

YOOT(I) = XN*YANTH*X1R0-XN*YAMTH*XIR0SQ-K* ( XFTHLD+ XHPHLD*X1R0I 

1 -X1*!SAVYI24)*A+K*XFTHLD*B*SAVY!25>*Y00T i 1+4 J + SAVYI4 >* 

2 K*XFPHLD+SAV Yl 26 ) +YAOPH+SAVY 19) *K*XFZELD+! YANTH* 

3 SAVY!9)+YAOPH*SAVY! 7)-YPRED! l+7)*SAVYI8l -YANPT* 

4 SAVYI5) )/RO )-X3*SA VY 1 33 ) 

YDOT C I ♦ 1 > = -XN*X1RO*YPRED!I)-XN*YAMPT*X1ROSQ-K*XFPHLD-X1* 

1 ISAVY(25>*A+K*XFPHLD*B-SAVY|26)*YPRED!I+?>-SAVY!5>* 

2 K*XFZELD) 

3 -X3*SAVY! 34 ) 

YDOT ! 1+2 ) = -YANTH*X 1R0+XNSQ*YAMTH*X1R0 SQ+K* t XN*XHPH LD*X1RD- 

1 XFZ ELD )-Xl*! SAVY! 26 )*A+K*XF ZELD*B-SAVY !2 4) *Y AOPH- 

2 SAVY ! 9) *K*XFTHLD+SAVY !25)*YPREO! 1+7 > + SAV Y(5) *K*XFPHLD> 

3 -X3*SAVY| 35 ) 

YDOT (1*3) = -2.0*XN*YAMPT*X1R0+YAJPH+K*XMTHLD 
1 +X3*SAVY ( 36 ) 

YDOT ( 1+6 )=YPREO! 1*7 ) 

YDOT ( 1+7 )- = I 1.0/!X022-XNUTP**2*XDll ) )* I-YPREO! 1+3 >♦ XNUTP*YAHTH+ 

1 K*!XNUTP*XNTTH-XMTPH)-X2*!SAVY!14)-XNUTP*SAVY!13m 

2 +X3*SAVY!53) 

GO TO 9005 

7786 GO TO ( 4771 , 4772,4773 1 , IGEOM 
C THE FOLLOWING EQUATIONS ARE THE *ST10* SET 
C EQUATIONS FOR SHELLS OF REVOLUTION I PHI COORDINATE ) 

4771 CONTINUE 

YAOPH = XN*YPREDI 1+6 ) *X1R0-YPREDI 1+4 )*SNlRCf 

YANTH = XK12*( 1 .0/1 XK22+XC22**2/XD22 ))* I YPRED ! 1+ 1 ) +K*XNTPH+ 

1 X2*SAVY ( 1 1 1 ♦ I XC22/XD22 )*! YPRED 1 1 +3 > +K*XMTPH+X2* 

1 SAVY ! 14 ) J )— K*XNTTH-X2*SAVY ( 10 >♦! X1R0*XK1 1- 

1 XK12*XK21*X1R0*! 1.0/ 

2 !XK22+XC22**2/X022>) )*! XN*YPRED ( 1+4 ) ♦ YPRED C I* 5) ♦CS-YPREDI 1+ 

3 6)*SN+X1*R0*YA0PH*SAVY!9) )- I XC 1 1+XK 12*XC 22*XD21 /XD22* 

3 11.0/!XK22+XC22**2/X022m* 

4 !X1R0**2*(XN*YPRE0! 1+4 )*SN— XN**2*YPREDI I +6 I )+ YPRED ( 1+7) *CS* 

5 X1R0) 

6 +X3*SAVY!48) 

YAHTH = -XD12*! XC22/ ! XC22**2+XK22*XD22 ) )*!YPRED! 1+ 1 ) +K+XNTPH+ 

1 X2*SAVY { 1 1 )) -K*XMTTH-X2*SAVY 113) +XD12* !XK22/ ! XC22**2+ 

2 XK22+X022I >*!YPRED! I +3 ) +K*XMTPH+X2*SAVY1 14l)+!XCll* 

2 XlRa+XD12*XK21*XlRO*!XC22/IXC22**2+XK22*XD22 ) ) I* !XN*YPREDf 

3 I+4)+YPRED!I+5)*CS-YPRED!I +6 )*SN+X1*R0*Y AOPH*SAVY| 9 ) ) + 

3 1XD11-XD12*XK22*X021/! 

4 XC22**2+XK22*XQ22 ) I ♦ < X 1RQSQ* ! XN* YPRED! I +4) *S N-XNSQ*YPRED 

5 < 1+6) KYPRED1 1+7 )*CS*X1R0> 

6 +X3*SAVY!49) 

YAMPT = (-1.0/1 (RO/XD33)+!SNSQ*X 1RO/XK33 ) ) )*(-2. 0*XN* 

1 YPRED! I +7 ) +YPRED! I +4)* !C SIR 1-CN1R0 ) + XN*Y PRED ! I ♦5 ) * 

2 (SN1R0+X1RI )+2.0*XN*YPRED( I +6 ) *C S1R0+YPR ED ( I >*SN/ 

3 XK33+X2*! SAVY! 12 )*SN/ XK33-S AVY ( 15 )*RO/XD 33 >+SN*Xl* 

4 ( YAOPH*SAVY( 5 ) + SAVY! 9.)* YPRED ! I +-7 ) ) ) 

5 +X3*SAVY(50I 

YANPT = YPRED! I )+YAMPT*SN 1R0 

YAJPH = YPRED!I+2)+Xl*(SAVYI8>*YA0PH+YANPT*SAVYI9>-YPRED(I+l> 

1 *SAVY( 5 )— YPRED! I+7)*SAVY(6) ) 

YDOT l 1+4 » = Rl*! YPRED! I +4 )*CS 1R0+XN* YPREDU +5 > *X1R0+ YPRED! I) /XK33+ 

1 X2*SAVY< 12)/XK33+YAMPT*SN1R0/XK33)+R1*X1*(YA0PH* 

2 SAVY!5)+YPRED( I+7)*SAVY(9> ) 

3 +X3*SAVY(5l) 

YOOTI I *5 ) = Rl*( YPRED! 1*6 l*X IR i-Xl* YPRED 1 1 + 7 )*SA VY(5 l+(l .0/(XK22+ 

1 XC22**2/XD22> >*! YPRED! 1 + 1 )+K*XNTPH+X2*SA VY ! 1 1) ♦( XC22/ 

1 XD22 )*! YPRED! 1+3 ) +K*XHTPH+X2*SAVY! 14 ) )-XK21*XlR0*( XN* 
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2 

2 

3 

4 

5 

A = 

1 

B = 

1 

YOOTtll 

1 

2 

3 

A 

5 

YDOT 11*11 

1 

2 

3 

A 

YDOT f 1+2 I 

1 

2 

3 

4 

5 

YDOT (I +3 V 

1 

2 

YDOT { 1+6 ) 
YDOT ( 1 + 7 ) 

1 

1 

2 

3 

A 

5 


YPREDl I+4I+YPREDI 1+5 )*C S- YPRE01I+6) *SN)-X1*XK12*YA0PH* 
SAVY l 9 ) - ( XC22*XD21/X022 

)*<X1R0SQ*IXN*YPRE01 I+4)*SN-XNSQ*YPREDU+6) KYPREOlI + 7) 
*CS*X1R0 ) ) ) 

♦X3*SAVY ( 52 ) 

YPREDl 1+5 )*CS1R0- YPREDl 1+6)* SN1R0+SAVYI9)*YA0PH+ 

YDOTC I+5)/Rl-YPREDl I +6 ) /Rl+S AVY l 5) *YPRED ( 1+7 ) 

SAVY { 1 1 *CS1R0-SAVY { 3 )*SNlRO+.5* l SAVY 1 9)* SAVY (9 ) 

♦SAVYl 5 )*SAVYl 5) ) + 1 SAVYl 2)- SAVY 13)) /R1 
= Rl*l-2.0*YPREDII)*CS1RO+XN*YANTH*X1RO-XN*YAHTH*SM* 
X1R0SQ-YAHPT*CS 1RO* ( X 1R 1-SN1RO ) )-Rl*K*lXFTHLD+XMPHLD* 
SN1RO )-Rl*X 1*1 SAVY ( 2A ) *A+K*XFTHLD*8+SAVY 125) *YDOT I 1*41 
/Rl+SAVYl 4)*K*XFPHLD/R1+SAVY126) *YAOPH+S AVY19) *K* 
XFZELD+SN/RO*l Y ANTH*SAVY 19) +YAOPHASAVY17 )-YPRED 1 1+7 1* 
SAVY C 8 )-YANPT*SAVYl 5 I ) )-X3* SAVYl 33) 

= Rl*lCSlRO*l YANTH- YPREO ( I+l) )-XN*XlR0*l YPREOl I )♦ 

YAMPT*< SN*X1R0+X1R1 ) ) +YPREDI 1 + 2 >*XIR1 )-R i*K*XFPHLD 

-R1*X l* l SAVY l 25 )*A+K*XFPHLD*B 

-SAVY l26)*YPREDlI+7)-SAVYl5J*K*XFZELD) 

-X3*SAVY ( 34 ) 

= Rl*l-YPR£Dl I +2 )*CS 1R0-YANTH*SN1R0-YPREDI I+1)*X1R1 
+XNSQ*YAMTH*XlR0Se-2.0*XN*YAHPT*CS*XlR0SQ)+Rl*K* 

( XN*XMPHLD*X1R0-XFZELD )-Rl *X1* t SAVY i 26)* A+K*XFZELD* 
B-SAVY124)*YA0PH-SAVY19J*K* 

XFTHLO+SAVY ( 25)*YPREDl 1+7 > ♦SAVY ( 51 *K*XFPHLD> 

-X3*5AVY (351 

* Rl*lYAMTH*CSlRO-YPREOl I+3)*CS1R0-2.0*XN*YAMPT*X1R0+ 
YAJPH+K*XMTHLD) 

♦X3*SAVY(361 A 

= Rl*( YPREDl I+7J-YPREOI I+5)*X1R1) 

* Rl*ll-XC22/lXC22**2+XK22*X022) )*l YPRED (I +1 )+K*XNTPH+ 
X2*SAVY (111-1 XK21/R0) * ( XN*YPRED ( 1+4 l+YPRED C 1 +5 )*CS— 
YPRE0(I+6)*SN1-X1*XK12*YA0PH*SAVY(9) )+lXK22/lXC22**2+ 
XK22*XD22) )* (YPREDl I +3 > +K*XMTPH+X2* SAVYl 14) )-(XK22* 

XD21/IXC22**2+XK22*X022))* ( XIROSQ* l XN*YPRE Dl 1 + 4 ) *SN-XNSQ 
♦YPREOl 1+6) )+YPREDU+7)*CS*XlRO>) 

♦X3*S AVY ( 53 ) 


GO TO 9005 

C EQUATIONS FOR CONE 

4772 CONTINUE 

YAOPH = XN*YPRE0(I+6)*X1CS/S-YPRED(I+4)*TAN/S 

YANTH = XK12*11.0/IXK22+XC22**2/XD22))*IYPREDII+1)+K*XNTPH+ 

1 X2*SAVYU1) + IXC22/X022)* l YPREDl I +3 ) +K*XMTPH+X2* 

l SAVY ( 14) ) )-K*XNTTH-X2*SAVY( 10)+ll.0/(CS*S)) 

1 *(XKll-XK12*XK21*l 

2 1.0/(XK22+XC22**2/XD22)) )*(XN*YPRED( I+4)+YPREDI l+5)*CS- 

3 YPREDl I+6)*SN+Xl*S*CS*YA0PH*SAVY(9) ) — C XC 1 1+ 1 XX12*XD2 1 * 

3 XC22/XD22)*( 1 .0/ ( XK22+XC22* 

4 *2/XD22 ) ) )*l U.0/IS**2*CS**2> )*IXN*YPREDI I+4)*SN-XNSQ*YPRE0 

5 ( 1+6) )+YPRE0( I+7)/S) 

6 +X3*SAVY( 48 ) 

YAMTH = -XD12*IXC22/IXC22**2+XK22*X022) )*IYPRE0( 1+ l ) +K*XNTPH+ 

1 X2*S AVY ( 1 1 ) )-K*XMTTH-X2* SA VY 1 13 ) +XD 12* (XK22/ (XC22**2 + 

1 XX22*XD22 ))*lYPRED(I+3) +K+XMTPH+X2* SAVYl 14)> + IXC11/ 

2 (S*CS)+XD12*XK21/( S*C S) )*lXC22/( XC22**2 + XK22 *XD22) )*(XN* 

3 YPREDl 1+4 )+YPREOl 1+5 )*CS-YPREDl 1+6 )* SN+X 1* S*C S* YAOPH* 

3 SAVYl 9) )+(XDll-XD12*XK22* 

4 X021/IXC22**2+XK22*X022) )*l ( 1 .0/ ( S*CS) **2 ) *1 XN*YPREDU+4 )* 

5 SN-XNSQ*YPR£Dl 1+6) )+YPREDl I+7)/S) 

6 +X3*SAVY ( 49 ) 

YAMPT=l-1.0/HS*CS/X033) + lSN*TN/lXK33*S> ) ) ) * 1-2. 0*XN*YPREDI I +7 )- 
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2002850 
2002860 
2002870 
2002880 
2002890 
2002900 
2002910 
2002920 
2002930 
2002940 
2002950 
2002960 
2002970 
2002980 
2002990 
2003000 
2003010 
2003020 
2003030 
200 3040 



1 

2 

3 

A 

5 


1 

1 

2 

3 

1 

2 

2 

3 

3 

A 

1 

1 

1 

2 

3 

A 

5 

1 

2 

3 

1 

2 

3 

A 


YPREOl I+A)*SN/S+XN*YPRE01I+5)*TN/S+2.0*XN*YPREDlI+6)/S+YPRED 
1 1)*SN/XK33 + X2*1SAVYI 12 )*SN/XK33-SAVY < 15 > *S*CS/XD33 ) 
♦SN*X1*1 YAOPH* 

SAVY(5)+SAVY19)*YPREDt I + 7>) ) 

♦X3*S AVY ( 50 I 

YANPT = YPREOl I )+YAMPT*TAN/S 

YAJPH = YPRED1 I +2 )+X 1* 1 SAVY! 8 ) * YAOPH+YANPT* SA VY1 9) -YPRED1 I +1 ) * 

SAVY ( 5 ) -YPREO( I+7)*SAVY16) ) 

YD0T1 I +A 1=11. 0/S)*l YPREOl I+A)+XN*YPREDl I *5 ) *X 1CS+YAMPT*TN/XK33 ) 
♦YPREO( I)/XK33+X2*SAVY112)/XK33+Xl*tYA0PH*SAVY15) 
♦YPREOl 1 + 7 ) *S AVY1 9 ) ) 

♦X3*SAVYt 51 J 

YDOT ( 1+5 ) = -X1*YPRED1I+7)*SAVY15)+11.0/(XK22+XC22**2/XD22J)* 

( YPREO 1 I+1)+K*XNTPH+X2*SAVY( 11 I + I XC22/XD 22 )* 

( YPREO( I+3)+K*XHTPH+X2*SAVY< 1A) )-(XK21/t S*CS))*IXN* 
YPREOl I+A I+YPRED1 1*5 )*CS-YPRED< 1+6) *SN)- Xl*XK12*YA0PH* 
SAVY19)-1XC22*XD21/XD22)*1 l 1 .0/ t S**2*CS** 

2) )*l XN*YPRED1 I+A)*SN-XNSQ*YPRED1 1+6) ) +YPR ED C I +7 ) /S) ) 
+X3*SAVY ( 52 ) 

A = YPREDlI+5)/S-YPREDII+6)*TN/S+SAVY(9) *YAOPH+YDOT C 1+5 > 

+SAVY 15)*YPREDI 1+7) 

B = SAVY< 1)/S-SAVY( 3 )*TN/ S+0 . 5* 1 SAVY 1 9) *SA VY 19J+SAVY15)* 

SAVY 15)') + SAVY12) 

YDOr(I ) =-2.0* YPREO ( I )/S+XN*YANTH*XtCS/S-XN*YAMTH*SN*XlCS**2/S**2 

♦YAMPT*TAN/S**2-K* 1 XFTHLD+XMPHLD*TAN/S )- XI* ( SAVY (2A ) * 
A+K*XFTHLD*B+SAVY 1 25 )*YDOT ( I +A ) +SAVY ( A )*K*XFPHLD+ 

SAVY l 26)*YA0PH+SAVY(9)*K*XFZELD+TAN/S*1YANTH*SAVY19)+ 
YAOPH*SAVY( 7 )— YPRED1 1+7 )*SA VY ( 8 )-YANPT*S AVYC 5 ) ) )-X3* 
SAVY ( 33 ) 

YDOT ( 1+1 )= -YPREOl I+1)/S+YANTH/S-XN*YPREDI I ) / I S*CS )- XN*YAMPT*SN/ 

( S*S*CS*CS )-K*XFPHLD-X 1* ( SAVY(25)*A+K*XF PHLD*B— 

SAVY! 26 )*YPREO( 1+7 l-SAVY 1 5 ) *K*XF ZELD ) 

-X3*SAVY(3A) 

YDOT 11+2) = -YPRED1 I+2)/S-YANTH*TAN/S+XNSQ*YAMTH/lS**2*CS**2) 

-2.0*XN*YAMPT/1 S**2*CS ) +K* 1 XN*XMPHLD*X1C S/S-XFZE LD ) 
+X1*( SAVY ( 26 J*A+K*XFZELD*B-SAVY t 2A ) *YAOPH-SAVY 19 )*K* 
XFTHLD+SAVY 1 25 ) *YPRED( I+7I+SAVY1 5)*K*XFPHLD> 

-X3*SAVY 1 35 ) 

YDOT 1 1+3 )= YAHTH/S- YPREOl I + 3 ) /S-2. 0*XN* YAMPT/l S*CS ) + YAJPH+XMTHLO 


1 *K 

2 +X3*S AVY 1 36 ) 

YDOT 1I+6)=YPRED1 1+7) 

YDOT 11+7) = -<XC22/1XC22**2+XK22*XD22) )*(YPRED1 I+l )+K*XNTPH+X2* 

1 SAVY l U)-XK21*IXN*YPRED( I+A)+YPRED1 I+5)*CS-YPRED 1 1+6 )* 

1 SN)/1S*CS)-X1*XK12*YA0PH*SAVY19) )+lXK22/ (XC22**2+XK22* 

2 XD22 ))*< YPREOl 1+3 )+K*XHTPH+X2*SAVYl 1A) )- tXK22*X021 

3 / 1 XC22 **2 +XK22*XD22))*l 1 l . 0/ 1 S*CS ) **2 ) *1 XN*YPRED 1 I +A )*SN 

A -XN** 2* YPREOl 1+6 I ) + YPRED( 1+7) /S) 

5 +X3*SAVY 1 53 ) 


GO TO 9005 

: EQUATIONS FOR CYLINDER 

A773 CONTINUE 
YAOPH 
YANTH 


1 

1 

1 

2 

2 

3 

A 


= X1R0*1XN*YPRED1 I+6J-YPREDII+A)) 

= XX 12*1 1 .0/1 XK22+XC22**2/XD22 ) )* 1 YPRED1 1+ 1 1 +K*XNTPH+ 
X2*SAVY 111)* 

1XC22/X022)*1YPRED1 1+3 ) +K*XMTPH+X2*SAVY( 1A ) I )-K*XNTTH- 
X2*SAVY( 10 )+(XlR0*lXKli-XK12*XK2 1*1 1.0/1 XK22+XC22**2/ 
XD22) ) ) )*lXN*YPREDlI+A)-YPRED!I+6)+Xl*R0*YA0PH* 

SAVY19) ) — 1 XC 11+1 

XK12*XC22*X02 1/XD22 1*1 1.0/1 XK22+XC22**2/XD22) ) ) * 1 X1R0**2* 1 
XN*YPRED1 I+A)-XNSQ*YPRED1 1+6 ) )) 


2003050 
2003060 
2003070 
2003080 
2003090 
2003100 
2003110 
2003120 
2003130 
20031A0 
2003150 
2003160 
2003170 
2003180 
2003190 
2003200 
2003210 
2003220 
2003230 
20032A0 
2003250 
2003260 
2003270 
2003280 
2003290 
2003300 
2003310 
2003320 
2003330 
20033AO 
2003350 
2003360 
2003370 
2003380 
2003390 
2003A00 
2003A10 
2003A20 
2003A30 
2003AA0 
2003A50 
2003A60 
2003A70 
2003A80 
2003A90 
2003500 
2003510 
2003520 
2003530 
2 00 3 5 AO 
2003550 
2003560 
2003570 
2003580 
2003590 
2003600 
2003610 
2003620 
2003630 
20036A0 
2003650 


164 



5 +X3*SAVY( 48 ) 

YAMTH = -XD12*(XC22/(XC22**2+XK22*XD22) )* I YPREDI I+1)+K*XNTPH+ 

1 X2*SAVY(il)) — K*XMTTH-X2*SA VYI 13 >+XD12* (XK22/ (XC22**2+ 

2 XK22*XD22) )*(YPR£D( 1+3 )+K*XMTPH+X2*SAVY( 14))+(XC11* 

2 X1R0+X012*XK21*X1R0*(XC22/IXC22**2+XK22*XD22 I) )*(XN*YPRE0 

3 ( 1+4 )—Y PREO( I+6)+Xl*R0*YA0PH*SAVY(9) ) + (XD1 1- XD12*XK22* 

3 XD21/IXC22**2+XK22*XD22) 

4 )*( XlROSQ*(XN*YPRED< I+4)-XNSQ*YPRED( 1+6 ) > ) 

5 +X3*SAVY I 49 ) 


YANPT = I -1 . 


YANPT 
YAJPH = 

l 

YDOT< 1+4) 


YOOT 11+5) = 


1 

2 

) 

1 

2 

3 

4 

5 


A = 


B = 


YOOT ( I ) 


1 

2 

3 

4 

1 

1 

2 

3 

1 

2 

3 


YDOTU + 1J 


YOOT ( 1+2 ) = 


YOOT 1 1 + 3) = 

1 

YOOT 1 1+6 ) ; 
YOOT ( 1+7 ) 

1 
1 
2 

3 

4 

9005 CONTINUE 
RETURN 
END 


0/((R0/X033)+(XlR0/XK33) ) )*(-2.0*XN*YPRED( 1+7) +XN*X1R0* 
YPREO( I+5)+YPRED(I)/XK33+X2*(SAVYI12)/XK33-SAVY(15)* 
R0/XD33 )+Xi* I YAOPH*SAVY (5)+SAVY(9)*YPREDII+7 ) ) ) 
+X3*SAVY(50) 

= YPREDI I)+YAMPT*X1R0 

YPREO ( I+2)+Xl*(SAVY(8)*YA0PH+YANPT*SAVY(9)-YPRED(I+l) 
*SAVY(5)-YPRED( t+7 )*SAVY(6) ) 

= XN*YPRE0( 1+5 )*X1R0+YPRED( I > /XK33+X2*SAVY ( 12 ) /XK33+ 
YAMPT*X1R0/XK33+X1*< YAOPH*SAVY( 5)+YPRE0( I+7)*SAVY(9> ) 
+X3*SAVY ( 51 ) 

-X1*YPRE0(I+7)*SAVY(5)+(1.0/(XK22+XC22**2/XD22))* 
(YPREDI 1 + 1 ) +K*XNTPH+X2*SAVY 1 11 ) ♦ I XC 22/XD 22 )* 

(YPREDI 1 + 3 ) +K*XMTPH+X2*SAVY I 14 ) )- 1 XK21*X 1R0) * I XN* 
YPREDI I +4 )-YPR£0( 1+6) )-Xl*XK12* YA0PH*SAVY(9) -IXC22* 

XD2 1/X022 )*(X1R0SQ*(XN*(YPRED(I +4 )- XN* YPREDI 1+6) )))) 
♦X3*S AVYI 52 ) 

-YPREDI I + 6)/R0+SAVY 1 9 )*YAOPH+YDOT( I+5)+SAVY(5)* 

YPREDI I +7 ) 

-SAVY 1 3 ) /RO+O. 5* ISAVY(9)*SAVYI9)+SAVY(5) *SAVY(5) >♦ 
SAVYI2) 

XN*YANTH*X1R0-XN*YAHTH*X 1R0SQ— K* I XF THLD+ XMPHLD*X1R0) 
—XI* I SAVY 1 24 ) *A+K*XFTHLD*B+S AVY 1 25 ) *YDOT 1 1+4 )+SAVY 14 )* 
K+XFPHLD+SAVY I 26 ) *YA0PH+SAVY I 9 ) *K*XFZELD + 1 YANTH* 
SAVY(9)+YA0PH*SAVY( 71-YPREDI 1+7 )*SA VYI 8) -YANPT* 

SAVY I 5 ) >/RO)-X3*SAVY(33> 

-XN*X1R0*YPRED( I )-XN*YAMPT*XlROSQ-K*XFPHLD-Xl* 

I SAVY I 25 )*A+K*XFPHLD*8-SAVY (26)* YPREDI 1+7 ) -SAVY I 5 ) * 
K*XFZEL0) 

— X3*SAVY I 34 ) 

-YANTH*X1RO+XNSQ*YAHTH*X1ROSQ+K*(XN*XMPHLD*X1RO- 
XFZEL0I-X1*(SAVY(26) *A+K*XFZELD*B-S AVY (2 4) *Y AOPH- 
SAVY(9)*K*XFTHL0+SAVY(25)*YPRED( 1+7 )+SAVY( 5) *K*XFPHLD) 
-X3*SAVY I 35) 

— 2. 0*XN*YAMPT*X1R0+YA JPH+K*XMTHLD 
♦ X3*S AVY I 36 ) 

YPREDI 1+7) 

= -IXC22/(XC22**2+XK22*XD22) ) * I YPRED 1 1+ 1 )♦ K*XNTPH+X2* 
SAVY Ill)-XK21*X1R0*( XN*YPRED I I+4)-YPRE0( 1+6) )-Xl*XKl2* 
YA0PH*SAVY(9) ) + ( XK22/ I XC 22**2+XK22*XD22) )* I YPRED 1 1 + 3 » + 
K*XMTPH+X2*SAVYI 14 ) )- I XK22*XD21 / I XC 22**2 +XK22*XD22 )) *1 
X1R0S0* I XN*YPRED 1 1+4 ) -XNSQ*YPRED 1 1+6 ) ) ) 

+X3*SAVY( 53 ) 


2003660 

2003670 

2003680 

2003690 

2003700 

2003710 

2003720 

2003730 

2003740 

2003750 

2003760 

2003770 

2003780 

2003790 

2003800 

2003810 

2003820 

2003830 

2003840 

2003850 

2003860 

2003870 

2003880 

2003890 

2003900 

2003910 

2003920 

2003930 

2003940 

2003950 

2003960 

2003970 

2003980 

2003990 

2004000 

2004010 

2004020 

2004030 

2004040 

2004050 

2004060 

2004070 

2004080 

2004090 

2004100 

2004110 

2004120 

2004130 

2004140 

2004150 

2004160 

2004170 

2004180 

2004190 
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FOR. IS 00E2.0DE2 

SUBROUTINE 00E2, 

INTEGER SAVJTC.SAVSTP.Q, THICK 
INTEGER XNl.XN 
REAL K 

DOUBLE PRECISION YPRED 

COMMON STORY ( 16 ) , XMAT l 270, 10 1 , STDl 10) , SADUSI 30 ) .RAOUSI 30 ) 

COMMON TADUS (30 ) .UADUS ( 30 ) , SAVTIC ( 900) 

COMMON XN.TEFREE, TIC, PHI, STOP, RESTOP, RT ICK.Gl ,XNL ( 3) ,NH 
COMMON NST(301 ,NKL( 30 ) , NXMAT ( 20 ) , SAVJTC 130) , SAVSTP (30) ,JRTIC(30) 
COMMON JRSTOP(30),NREG,NMPT,NRC,NSC,NIX, IERROR , K6E0M , IGEOM, I STT A8 
COMMON KELVIN, I BEGIN, NPROB.NSEG, NERROR.Q, THICK, NOJS.NL INKS, NLCASE 
COMMON NTSKL, NZ, NBCT, L INPUT, N TRKL ,NPA SS , XN1 ,KBC , NRINGS 
COMMON LODE.ICYCLE.LOISTL 

COMMON /LASTEQ/ YPREOI 8 ) , YDOT ( 8 ) , YASAVE ( 8 ) , 

YANTH.YAMTH.YAMPT, YANPT , YAOPH, YAQPH, YAOTH, YA JPH, 

S, SN.CS, SNSQ.CSSQ, TAN.SEC.CN ,X1CS« XI SN, TN, 
X1R0.X1R0SQ, X 1SNR0 , X1CSR0,CN1R0,SN1R0,CS1R0, 
X1R1,X1R2,CS1R1,CS1R2,SN1R1,X1R1SQ,R2SQ,R0,BESQ, 

RO SQ, XNSQ, BETA, R1,R2, SI, R1 DOT, RISC, 

XNTTH,XNTPH,XMTTH,XMTPH,XFTHLO,XFPHLD,XFZELD, 
XMTHLD,XMPHLD,ETHET,EPHI, XGP T, ALPHTH , A LPHPH , 
XNUTP,XNUPT,XC11,XC22,XC15,XD33,XD22 ,XD21,XD12, 
XK11,XK12,XK21,XK22,XK33,XD11, 

M, I,SITIN,SITOUT,SIPIN,SIPOUT,TPTIN,TPTOUT, 
ZBRIN.ZBROUT.SCRIPA, SCR IP I , SIF I N, SIFOUT , TZEPH .TZETH 
,XNPHI,BETTA,ZETTA,XC16 

, RMOSS.RMOSN, YLDST.ROC, HP.FPLUH ,GPLUH ,TWON 
, RMOSSY , RMQSNY.RMOSX Y.RNONXY 
,RMOSNS,RMQSSS , SIGOXS, RMOSNR,RMOSSR, S IGOXR 
COMMON / PLS/ OMEGA, IMORD.XMERO.XPRES.XMONT 

COMMON /WOOD/ S AVY( 53 ) , NPLEV, NLPO, NPLA ( 21 ) , STR (6 ) , SI GMA ( 3,21 ) , 
SEPS( 3,21 ) ,SALPH( 3,21) ,SBAPH(3,21 ) .STEPS (3,21), 
EFF(21),STSRN(3 ),NPLAST( 3),STSIG( 3), STREPS! 3) , 
STALPH(3),ST8APH(3),EFFST(3),NPLEVS(3) 

COMMON /CDISP/ P,PMAX,DELP,DELP1,YEPS,ZEPS 
EQUIVALENCE (XNL ( 1 ) , XI ) , ( XNL < 2 ) , X2 ) , ( XNL ( 3 ) , X3 ) , (K.DELP) 

GO TO (7341, 73*2,7343), IGEOM 
C THE FOLLOWING EQUATIONS ARE THE *RWAF • SET 

C EQUATIONS FOR SHELLS OF REVOLUTION ( PHI COORDINATE > 

7341 CONTINUE 

YAOPH = XN*YPREO( 1+6 J*X1R0-YPRED ( I +4 )*SN1R0 

YANTH = (YPRE0(I+l)+K*XNTPH+X2*SAVY(ll) J * ( XC15*XC22+XD22*XK12) 

/(XK22*XD22+XC22**2)-K*XNTTH-X2*SAVY(l0)+( XK12*XC22- 
XK22*XC 15 )*( YPRED ( 1+3 >+K*XMTPH+X2*SAVY(l4> )/ (XC22* 
XC22+XK22*XD22)+(X1R0*(XN*YPRED( 1+4 )+YPRED (I +5 )*CS- 
YPRED( I +6 ) *SN ) +X 1*YA0PH*SA VY (9) )*(XKll + ( XC15*(XC15* 
XK22-2.0*XK12*XC22)-XK12*XK12* 
XD22!/(XK22*XD22+XC22*XC22) )+ ( X 1R0SQ* ( XN*YPRED ( I+4)*SN-XNSQ 
♦YPRED! 1+6) )+XiRO*YPRED( I +7 )*CS ) * ( -XC l l+( XC 15*XC1 5* XC22+ 
XC15*(XK12*X022+XK22*X012 )-XK12*XD12* XC22) / ( XK22*XD22+XC22*XC22 ) ) 
+X3*SAVY ( 48 ) 

YAMTH= (YPRED! 1+3 ) +K*XMTPH+X2*S AVY ( 14 ) )*( XC15*XC22+XK22*XD12) 

/ ( XK22*XD22+XC22*XC22 )+( YPRED ( I +1 )+K*XNTPH+X2*SA VY 111) 
)*( X022*XC15-XD12*XC22 ) / ( XD22*XK22+XC22* *2 )-K*XMTTH- 
X2*SAVY(13)+(X1R0S0*(XN*YPRED( I +4)*SN-XN SQ*YPRED ( 1+6 > > 
+X1R0*YPRED( I+71*CS)*(XDli-(XD12*XD12*XK22+XC15*(2.0* 
XC22*XD12-XC 15*XD22 ) ) /( XC22*XC22+XK22*XD22 ) ) ♦ (X1R0* 

( XN*YPRED( 1+4 )+ YPRED (1+5 )*CS-YPRED( 1+6 )* SN )+Xl*YAOPH* 
SAVY ( 9 ) )*(XC11+(XD12*XC22*XK12-XC15*( XC1 5*XC22+XD12* 
XK22+XD22*XK12) ) / ( XC 22*XC22+XK22*XD22 ) ) 

+X3*SAVY ( 49 ) 


1 

2 

3 

4 

5 

6 

7 

8 
9 
A 
B 
B 
C 
D 
D 


C 

0 

H 


1 

1 

2 

2 

3 

4 

5 

6 
7 

1 

1 

2 

3 

4 

5 

6 

7 

8 
9 


2100010 
2100020 
2100030 
2100040 
2100050 
2100060 
2100070 
2100080 
2100090 
2100100 
2100110 
2100120 
2100130 
2100140 
2100150 
2100160 
2100170 
2100180 
2100190 
2100200 
2100210 
2100220 
2100230 
2100240 
2100250 
2100260 
2100270 
2100280 
2100290 
2100300 
2100310 
2100320 
2100330 
2100340 
2100350 
2100360 
2100370 
2100360 
2100390 
2100400 
2100410 
2100420 
2100430 
2100440 
2100450 
2100460 
2100470 
2100480 
2 100490 
2100500 
2100510 
2100520 
2100530 
2100540 
2100550 
2100560 
2100570 
2100580 
2100590 
2100600 
2100610 
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YAMPT = (1.0/(XC16*SN*X1R0-XK33-SN*X1R0*IXD33*SN/I R0>-XC16)I) 

*( (XK33*X033-XC16**2)*X1RO*(-2.0*XN*YPRED(I*7)+YPRED(I*4)* 
(CS*XIR1-CN1R0)+XN*YPRED( I+5)*(X1R14SN1RO)+2.0*XN*YPRED 

( I+6)*CS*X1R0)+X1*SN*< YAOPH*SAVY(5)+YPREDI I47)*SAVVI9> 
)+( YPREOI I ) + X2*SAVY( 12 > I * ( XD33*SN*X 1R0-XC16) +X2* 

SAVYI 15)*(XK33-XC16*SN/RO> ) 

♦X3*SAVY(50> 

YANPT = YPRED( I )+YAMPT*SNlRQ 

YAJPH = YPREDI 1*2 >+X 1* I SAVYI 8 1 * YAOPH*YANPT*SAVY( 9> -YPRED 1 1 ♦! ) 

*SAVY(5)-YPRED( I*7)*SAVY<6> ) 

YDOTI 1+4) = Rl*t YPREDI 1+4 )*C$*X1R0+X1*I YAOPH*SAVY (5) 4YPREDI 1+7)* 
SAVY 1 9 ) ) 

+XN*YPRED( I+5)*X1R0+I 1.0/IXK33- 

XC16**2/X033) )*(YPRED( I J+YAMPT* ( SN*X IRO- XC 16/XD33 )+X2* 
(SAVY ( 12J-XC16*SAVY( 15J/X0 33))) 

♦X3*SAVY(51) 

YOOT ( 1+5 ) = YPREO(I46)-R1*X1*YPREO(I+7)*SAVY(5)+R1*( X022*( YPREDI I* 
1 )+K*XNTPH+X 2*SAVY I 11) )4XC22*(YPRED( 1 + 3) ♦K*XMTPH+X2* 
SAVY( 14 ) )-( X IRO* ( XN* YPRED (I+4)*YPRED(I*5 ) *CS-YPRED( I +6 
)*SN)+Xi*YA0PH*SAVY<9) )* 

(XK12*X022+XC15*XC22)-(X1R0SQ*(XN*YPREDI I+4J-XNSQ* 
YPREO( I+6))+X IRO* YPREDI I *7 ) *C S > * I XC22*XD 12-XC 15*XD22 > ) 
/( XK22*XD22*XC22**2) 

♦X3*SAVY ( 52 ) 

A = YPREDI I+5)*CS1R0-YPRED( 1+6) *SN1R0*SAVY (9 ) *YAOPH* 

YDOTI I + 5J/R1- YPREDI 1+6 1 /R 1+SA VY I 5 >* YPRED I 1+7 > 

B = SAVY 1 1 ) *CS1R0-SAVY I 3 ) *SN1R0+ .5*1 SAVY(9)*SAVY(9I 

♦SAVY I 5 l*SAVY (5))+(SAVY{ 2 1- SAVY I 3 ) )/Rl 
YDOTI I) => Rl* I ~2. 0*YPRE0( I )*CS 1RO+XN* YANTH*X1R0-XN*YAMTH*SN* 

XlRO$Q-YAHPT*CSlRO*tXlRl-SNlRO)>-Rl*K*tXFTHt_D+XHPHl.D* 
SN1ROJ— R1*X1*(SAVY(24 )*A*K*XFTHLD*B+SAVY l25)*YD0T(I+4) 
/R1+SAVYI4)*K*XFPHLD/R1+SAVYI26) *YAOPH+S AVYI9)*K* 
XFZELD+SN/R0*(YANTH*SAVY(9)+YA0PH*SAVY(7)-YPREDI 1+7)* 
SAVY I 8 ) -YANPT*SAVYI 5) ) )-X3*SAVYI 33) 

YDOTI !♦!) * Rl*( CS IRO* I YANTH- YPREDI I -*• 1 > )-XN*XlRO*IYPRED(I)+ 

YAMPT*(SN*X1R0+X1R1) l+YPREDI 1+2 ) *X1R1 ) -R 1*K*XFPHLD 

-R1*X l* I SAVY I25J*A+K*XFPHLD*B 

—SAVY (26)*YPRED(I+7)-SAVY(5)*K*XFZELD) 

— X3*SAVY I 34 ) 

YDOTII+2) = Rl*(-YPREO( 1*2 ) *CS1R0-YANTH*SN1R0-YPRED( I+1)*X1R1 
♦XNSQ*YAMTH*X 1R0SQ-2 . 0*XN*YAMPT*CS*X1ROSQ) +R 1*K* 

I XN*XMPHLO*X1RO-XF ZELD)-R1*X1*(SAVY(26)*A+K*XFZELD* 

B-S AVY I 24 ) *Y AOPH-S AVY I 9 ) *K* 

XFTHLD+S AVY I 25 )*YPRED( I+7)*SAVYI 5>*K*XFPHLD) 

-X3*SAVY I 35 ) 

YDOTII+3) = Rl*( YAMTH*CS1R0-YPRED< 1*3 )*CSlRO-2 . 0*XN* YAMPT*X1R0+ 
YAJPH*K*XMTHLO ) 

♦X3*SAVY I 36 ) 

YD0TI1+6) = Rl*(YPREO( I + 7)-YPR£D( I + 5)*X1R1) 

YDOTII+7) = Rl*(XK22*IYPRE0(I+3)+K*XMTPH+X2*SAVYll4> )-XC22* I YPREDI 
I + 1)+K*XNTPH+X2*SAVYIU) )+lXlR0*(XN*YPRED(I+4)+ 
YPRED(I*5)*CS-YPRED( 1 + 6 ) *SN ) + X1* YAOPH*SA VY 1 9 ) ) * I XK 12* 
XC22-XK 22*XC 15 ) 

-I X1ROSQ*! XN*YPREDI 1+4 )*SN-XNSQ*YPRED< I +6 ) ) ♦X1R0*YPRED I I * 7 ) *CS ) * 
(XC15*XC22+XK22*XD12))/(XC22**2+XK22*XD22) 

♦X3*SAVY 1 53 ) 


GO TO 9005 

C EQUATIONS FOR CONE 
7342 CONTINUE 

YAOPH = XN*YPRED( 1*6 )*X 1CS/S-YPREDI I+4)*TAN/S 

YANTH = (YPRE0H+1I+K*XNTPH+X2*SAVY(11) ) * I XC15*XC22+X022*XK12 1 


2100620 

2100630 

2100640 

2100650 

2100660 

2100670 

2100680 

2100690 

2100700 

2100710 

2100720 

2100730 

2100740 

2100750 

2100760 

2100770 

2100780 

2100790 

2100800 

2100810 

2100820 

2100830 

2100840 

2100850 

2100860 

2100870 

2100880 

2100890 

2100900 

2100910 

2100920 

2100930 

2100940 

2100950 

2100960 

2100970 

2100980 

2100990 

2101000 

2101010 

2101020 

2101030 

2101040 

2101050 

2101060 

2101070 

2101080 

2101090 

2101100 

2101110 

2101120 

2101130 

2101140 

2101150 

2101160 

2101170 

2101180 

2101190 

2101200 

2101210 

2101220 
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1 /(XK22*X022+XC22**2)-K*XNTTH-X2*SAVYU0) +(XK12*XC22- 

1 XK22*XC15)*( YPRED) i +3 ) +K*XMTPH+X2*SA VY )1 4) >/»XC22* 

2 XC22+XK22*X022)+< )XN*YPRED) 1+4 )♦ YPRED ( I* 5 ) *C S- 

3 YPRE0)I+6)*SN)/< S*CS > + X 1*YA0PH*SAVY ) 9) )* ( XK1 1* ) XC15* 

3 )XC15*XK22-2.0*XK12*XC22)-XK12*XK1 2* 

4 X022)/)XK22*XD22+XC22*XC22) )+< < XN*YPRED ) 1+4 )*SN-XNSQ* 

5 YPRED) 1+6) )/)S*S*CSSQ)+YPREO) 1+7 ) /S )* )- XC1 1+ )XC15*XC1 5*XC22+ 

6 XC15*)XK12*XD22+XK22*XD12)-XK12*XD12*XC22)/)XK22*XD22+XC22*XC22)) 

7 +X3*S AVY < 48 ) 

YAMTH = ( YPRE0( 1+3 ) +K*XMTPH+X2* SAVY { 14) ) * ) XC15*XC22+ XK22*XD12) 

1 /( XK22*XD22+XC22**2I+) YPRED ( 1*1 ) +K*XNTPH+X2*SAVY ) 11) )* 

1 IXD22*XC15-X012*XC22)/)XD22*XK22+XC22**2 >-K* XMTTH-X2* 

2 SAVY( 1 3 I ♦ C 1.0/( S*S*CSSQ )* ( -XNSQ*YPRED ) 1+ 6 ) +XN* 

2 YPRED) 1*4)* 

3 SN)+YPRED)I+7)/S)*)X0ll-)XD12*XD12*XK22+XCl5*t 2 .0*XC22*XD12-XC15* 

4 XD22))/)XC22*XC22+XK22*XD22) )+t 1 .0/ ( S*CS )*)XN* 

5 YPRED) 1+4) +YPRED) 1+5 1 *C S-YPRED ( I *6 ) *SN ) + Xl*YAOPH* 

6 SAVY<9) )*)XC11+)XD12*XC22*XK12-XC15*)XC15*XC22+XD12* 

7 XK22+XD22*XK 12) )/)XC22*XC22+XK22*XD22) I 

8 +X3*SAVY ( 49 I 

YAMPT =( )XC16*TAN/S-XK33-) TAN/S >*)XD33*TAN/S-XC 16) »♦*< -1 ) )* j (XK33* 

1 XD33-XC 16**2 ) *( 1.0/)S*CS) )*) -2 . 0*XN* YPRED ) 1+7 )- YPRED C 1+4 ) * 

2 SN/S+XN+YPRED) 1+5 ) *TAN/ S+2 . 0*XN* YPRED ( 1+ 6) /S )+Xl*SN* 

3 ( YAOPH*SAVY )5)+YPRED) ! +7 )*SAVY( 9 ) >♦ ( YPRE OC I > +X2* 

4 SAVY) 12))*<X033*TAN/S-XC16)+X2*SAVY)15)* (XK33-XC16* 

5 TN/S ) ) 

6 +X3*SAVY ( 50 1 

YANPT = YPRED( I )+YAMPT*TAN/S 

YAJPH = YPRE0( I+2)+Xl*(SAVY( 8)*YAOPH+YANPT* SAVY) 9 ) -YPRED ( 1 + 1 J * 

1 SAVY)5)-YPRED)I+7)*SAVY)6) ) 

YDOKI+4) = YPRED) I +4 )/ S+Xl*) YAOPH*SAVY ) 5)+YPREDtI+7 )*SA VY ) 9 ) )+XN* 
YPRE0( I+5)/)S*CS )♦( I.0/(XK33-XC16**2/ 

XD33) )*) YPRED ( I )♦ YAMPT* ( TAN/S-XC 16/XD33) +X2* I SAVY) 12 )- 
XC16*SAVY(15)/XD33n 
♦X3*SAVY( 51 J 

YDOT) 1+5 ) = — X 1 *YPRED( I + 7 )*SA VY) 5 ) ♦ ( XD22*C YPRED ( 1 + 1) +K*XNTPH+X2* 

SAVY) 11) )+XC22*(YPREDU+3)+K*XMTPH+X2*SAVY(14) )-(XK12* 
X022+XC15*XC22 )*) ) 1 .0/ ) S*CS > *) XN*YPRED> I +4 ) + YPRED > 1 + 5) 
*CS-YPRED) I +6 )*SN ) )+Xl*YAOPH*SA VY ( 9 > )- )XC22*XD12-XC15* 
XD22 )*( (-XNSQ* 

YPRED( I+6»+XN*YPRE0) 1+4 )*SN ) / ( S*S*C SSQ )+ YPRED( 1+7) /S) ) 

/ ) XK22*X022+XC22*XC22 ) 

+X3*SAVY( 52 ) 

A = YPREDt I+5I/S-YPRED1 1+6 )*TN/ S+SAVY 1 9 ) *YAOPH+YDOT ) 1+5 ) 

l +SAVY) 5 )*YPRED) 1+7) 

8 = SAVYU)/S-SAVY)3)*TN/S+0.5*)SAVYI9»*SAVY)9)+SAVY)5)* 

L SAVY ( 5 ) l+SAVY) 2 ) 

YDOT ( I ) =-2.0*YPRED) I)/S+XN*YANTH*X1CS/S-XN*YAMTH*SN*X1CS**2/S**2 

♦YAMPT*TAN/S**2-K* ) XFTHLD+XMPHLD*TAN/S )-Xi *) SAVY (24 ) * 
A+K*XFTHLD*B+S AVY ( 25 ) *YDOT { 1+4 ) +SAVY)4 )*K*XFPHLD+ 
SAVY(26)*YA0PH+SAVY)9)*K*XFZELD+TAN/S*)YANTH*SAVY)9)+ 
YAOPH*SAVY( 7)-YPRED( I +7 ) *SA VY) 8 )-YANPT*S AVY) 5 ) ) )-X3* 
SAVY ( 33 I 

YDOT ( I + i )= -YPREDII + D/S+YANTH/S-XN* YPRED) I ) /C S*CS)-XN*YAMPT*SN/ 
(S*S*CS*CS)-K*XFPHL0-X1*CSAVY( 25 )*A+K*XF PHLD*B- 
SAVY) 26 ) *YPRED) 1+7)- SAVY (5) *K*XFZELD ) 

-X3*SAVY ( 34 ) 

YDOT ( 1+2 ) = -YPRED) 1+2 ) /S-Y ANTH*T AN/ S+XNSQ* YAMTH/ ( S**2*CS**2 ) 

-2. 0*XN*YAMPT/ ( S**2*CS ) +K* ( XN*XMPHLD*X 1C S/ S-XFZELO) 

+X 1*( SAVY ( 26 )*A+K*XFZELO*B- SAVYI 24 ) *YA0PH-SAVY)9 > *K* 
XFTHLD+SAVY( 25 ) *YPREO ( 1+7) +SAVY ) 5) *K*XFPHL0) 

-X3*SAVY ) 35 ) 


2101230 
2101240 
2101250 
2101260 
2101270 
2101280 
2101290 
2101300 
2101310 
2 101320 
2101330 
2101340 
2101350 
2101360 
2101370 
2101380 
2101390 
2101400 
2101410 
2101420 
2101430 
2101440 
2101450 
2101460 
2101470 
2101480 
2101490 
2101500 
2101510 
2101520 
2101530 
2101540 
2101550 
2101560 
2101570 
2101580 
2101590 
2101600 
2101610 
2101620 
2101630 
2101640 
2101650 
2101660 
2101670 
2101680 
2101690 
2101700 
2101710 
2101720 
2101730 
2101740 
2101750 
2101760 
2101770 
2101780 
2101790 
2101800 
2101810 
2101820 
2101830 
2101840 
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Y00T(I+3)« YAHTH/S-YPRED ( 1*3 ) /S-2.0+XN* YAHPT/( S*CS)+ YA JPH+XMTHLD 

1 ♦K 

2 +X3+SAV Y ( 36 ) 

YDOTl I+6)=YPRED( 1*7 » 

YDOT (1*71 = (XK22+IYPREDII+3) +K*XMTPH+X2*SA VYl 14 ) )-XC22* 

1 ( YPRED( I+l)+K*XNTPH+X2*SAVYl 11 ) ) + ( XK12+XC22-XK22+XC15 ) 

2 *l(1.0/(S*CS)*(XN*YPRED( I+4)+YPRED( 1+5 )*CS-YPRED ( I +6 >* 

2 SN) )+Xl*YA0PH*SAVY(9) )- ( XC 15*XC22+XK22*X D12 ) * 

3 ( l-XNSQ+YPREDl 1+6 )+XN*YPRED( I+4)*SN) /( S*S*CSSQ )+ 

4 YPRED( 1*7 )/S) )/(XK22*XD22+XC22*XC22> 

5 +X3+SAVY ( 53 ) 


GO TO 9005 
C EQUATIONS FOR 

7343 CONTINUE 
YAOPH 
YANTH = 


CYLINDER 


X1R0*IXN*YPRE0( I+6)-YPRED( 1+4) ) 

( YPREOC I+l)+K*XNTPH+X2*SAVYt 11) >*(XC15*XC22+XD22*XK12> 
/( XK22*XD22+XC22**2 )-K*XNTTH-X2* SAVY ( 10) + ( XK12+XC22- 
XK22+XC15 )* ( YPRED ( 1 + 3 ) +K+XHTPH+X2+SAVY ( 14 ) )/(XC22* 
XC22+XK22*X022 ) ♦( X 1R0* t XN+YPRED C 1+4 )-YPRED 1 1 +6 ) )+Xl* 
YA0PH+SAVY19) )*(XK 11+ (XC 15*1 XC15+XK 22-2. 0+XK12+XC22 > - 
XK12+XK12* 

XD22) / ( XK22*XD22+XC22*XC22 ) ) ♦ ( X1R0SQ* l XN+YPRED (1+4) -XNSQ 
♦YPREDl 1+6) ) )*( -XC ll+l XC15+XC 15*XC22+ 

XC15+(XK12*XD22+XK22*XD12)-XK12*XD12*XC22)/(XK22*XD22+XC22*XC22 )) 
+X3+SAVY148) 

YANTH = (YPREDl 1 + 3) +K+XMTPH+X2+SAVY 114) )♦ ( XC15*XC22+ XK22*XD12 ) 

/(XK22*XD22+XC22**2)+(YPREDlI+i)+K+XNTPH+X2*SAVYlll) )♦ 
( XD22*XC15-X012*XC22 )/(X022*XK22+XC 22**2 )-K*XMTTH-X2* 
SAVY (13)+X1R0SQ*(XN*YPRE0( I+4)-XNSQ*YPRED( 1+6) ) 

* (XD1 1- ( X012*X012*XK22+XC 1 5* ( 2.0*XC22*XD12-XC1 5* 

X022 ) ) / ( XC22*XC22+XK22*XD22 ) ) + ( X1R0* t XN* YPREDl 1+4)- 
YPREO( 1+6 ) ) +X1*YAQPH*SAVYI 9 ) )*(XCll+( X01 2*XC22*XK12- 
XC15*(XC15*XC22+XD12*XK22+ 

XD22*XK12 ) ) / l XC22*XC22+XK22*X022 ) ) 

♦X3*SAVY ( 49) 

YAMPT= ( 1/ ( XC 16*X 1RO-XK33-X 1R0* ( X033*X1RO-XC 16 ) ) )* ( IX K33+X033-XC16 
**2 ) *X1R0*( -2.0*XN*YPRED (I+7)+XN*XlR0* YPREDl 1+5) )+Xl* 

( YAOPH+SAVY ( 5 ) +YPREO( 1+7 )*SAVY( 9 ) )♦ ( YPREDl I ) +X2* 

SAVY ( 12 ) ) *( XD33+X 1R0-XC 16) +X2*SA VY ( 15>*I XK33-XC16/R0) ) 
♦X3+SAVY ( 50 ) 

YPRED ( I )+YAMPT*XlRO 

YPREDl 1+2 1 +X 1* ( SAVY( 8 )*YAQPH+YANPT* SAVYl 9) -YPRED ( 1 + 1 ) 
*SAVY ( 5 )- YPREDl 1 + 7 J*SAVY (6) ) 

X1*(YA0PH*SAVY(5)+YPRED(I+7)*SAVY19> >+XN*YPRED ( 1+5) /RO 
♦ 

( 1.0/(XK33-XC16**2/XD33) )*l YPRED) I )♦ 

YAHPT*( X1R0- XC16/XD33)+X2*( SAVY( 12 >-XC 16 *SAV Yl 15 )/ 

XD33 ) ) 

+X3*SAVY( 51 ) 

-X1*YPRE0 ( I+7)*SAVY( 5 )+(XD22*( YPREDl I+1)+K*XNTPH+X2* 
SAVY (11) )+XC22*lYPREDl I+3)+K*XMTPH+X2*SAVY(14))-(XlR0* 
(XN*YPREO( 1 + 4 )-YPRE0( 1+6) )+Xl*YAOPH*SAVY (9) )*(XK12* 
XD22+XC 15+XC22 )-XlROSQ*(XN*YPRED 
XNSQ*YPREO( 1+6) )*(XC22*XD12-XC15*XD22 ) ) / ( XK22* XD22+XC22**2 ) 
♦X3*SAVY( 52 ) 

-YPREDl I+6l/R0+SAVY(9)*YA0PH+YD0T(I+5)+SAVY(5>* 

YPREDl 1+7) 

-SAVYl 3)/RO+0.5*(SAVY(9)*SAVY(9)+SAVY(5> *SAVY(5) )+ 

SAVY ( 2 ) 3 

XN*YANTH*X1R0-XN*YAMTH*XIR0SQ-K* (XFTHLD+ XMPHLD*X IRO ) 
-Xl*( SAVYl 24 )*A+K*XFTHLO*B+ SAVYl 25 )* YDOT (1+4 )+SAVY(4>* 


1 
2 
2 
3 

3 

4 

5 

6 
7 

1 
2 
2 

3 

4 

5 

5 

6 
7 

1 

2 

3 

4 

YANPT 
YAJPH = 

1 

YDOTl 1+4) 

1 

1 

2 

3 

4 

YDOTl 1+5) 

1 

1 

2 

2(1+4) 

3 

A = 


YDOT ( I ) 


2101850 

2101860 

2101870 

2101880 

2101890 

2101900 

2101910 

2101920 

2101930 

2101940 

2101950 

2101960 

2101970 

2101980 

2101990 

2102000 

2102010 

2102020 

2102030 

2102040 

2102050 

2102060 

2102070 

2102080 

2102090 

2102100 

2102110 

2102120 

2102130 

2102140 

2102150 

2102160 

2102170 

2102180 

2102190 

2102200 

2102210 

2102220 

2102230 

2102240 

2102250 

2102260 

2102270 

2102280 

2102290 

2102300 

2102310 

2102320 

2102330 

2102340 

2102350 

2102360 

2102370 

2102380 

2102390 

2102400 

2102410 

2102420 

2102430 

2102440 

2102450- 
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4 


2 K*XFPNL04SAW < 26 1 *YA0PH4SAW <9 1 *K*XFZEL04( YANTH4 

3 SAW(9 1 4YA0PH*SAVY { 7 )— YPRED( I47)*SAW(8) — YANPT* 

4 SAW (51 l/R0)-X3*SAW t 33 ) 

YD0TCI+1> * -XN*X1R0*YPRE0(I»-XN*YAMPT*X1R0SQ-K*XFPHLD-X1* 

1 I SAVY ( 25 ) *A+K*XFPHLD*B- SAVY ( 26 ) * YPRED t 1* 7 ) -S AVY ( 5 ) * 

2 K*XFZELD) 

3 -X3*S AVY ( 34 ) 

Y00T(I42) * -YANTH*X1R04XNSQ*YAMTH*XIR0SQ+K*(XN*XMPHLD*X1R0- 

1 XFZELD)-X1* ( SAWI26) *A4K*XFZELD*B-S AWI2 4 >*Y AOPH- 

2 SAWI 91 *K*XFTHLD4SAW ( 25 l*YPRED( 1*7 )4SAVY( 5) *K*XFPHLD) 

3 -X3*S AW ( 35 ) 

YD0TII43) = -2.0*XN*YAMPT*X1R04YAJPH4K*XMTHLD 
1 +X3*S AVY ( 36 ) 

YDOT ( 1+6 >*YPRED( 1*7 > 

YOOT 11*71 « IXK22*(YPRE0(l43>4k*XMTPH4X2*SAW(14» J-XC22* 

1 I YPREO( !♦! )4K*XNTPH4X2*SAW( toll )4(X1R0*< XNWPRED ( 144 )- 

1 YPRE0(l46>>4Xl*YA0PH*SAW(9)>*tXK12*XC22-XK22*XC15>- 

2 X1R0SQ*C XN*YPRED 

2(1 44 )-XNSQ*YPREO( 146) »* ( XC 15*XC224XK22*XD12 ) )/ ( XC22**24XK22*XD22 ) 

3 4X3*SAVY( 53 ) 


9005 CONTINUE 
RETURN 
END 

C ROUTINE 


** TOBAR ** ABACUS UPDATED 01/11/74 


2102460 

2102470 

2102480 

2102490 

2102500 

2102510 

2102520 

2102530 

2102540 

2102550 

2102560 

2102570 

2102580 

2102590 

2102600 

2102610 

2102620 

2102630 

2102640 

2102650 

2102660 

2102670 

2102680 

2200000 
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SUBROUTINE SHPLAS 


Subroutine SHPLAS is called from LEBEGE and incremental stress re- 
sultants, deformations and geometric data are passed to the subroutine 
in the label common area LASTEQ. The routine SHPLAS updates all values 
to the current load increment and calls a series of routines to obtain 
the plasticity history of the shell. 

Subroutines Called from SHPLAS 


Subroutine SHSRSE : Is a routine to calculate elastic stresses through- 

out the shell wall cross-section. 

Subroutine SEPSIS : Is a routine to calculate the plastic strain increments 

and the shift in the yield surface. The total stresses and plastic strains 
are also obtained. For this routine the material must be isotropic and 
the hardening laws either kinematic or istropic. 

Subroutine LINEQU : Is a small simultaneous equation solver. 

Subroutine OHTHKN : Performs the same function as SEPSIS, above, for 

orthotropic (kinematic hardening) plasticity. 

Subroutine EPS IS : Performs the same function as SEPSIS, above, for per- 

fectly plastic behavior. 

Subroutine SMEAR : Is a routine to calculate the plasticity effects of 

smeared reinforcement. 

Subroutine SAVXES : Is a routine which obtains an equilibrium and strain 

correction for each point in the shell, for a series of load steps. 

Subroutine ARRAYS : If the clues are set for graphical display of results, 

the necessary information is passed to this subroutine, which in turn 
arranges the information to be plotted into proper arrays. 


171 




FORTRAN CODE 


ENGINEERING SYMBOLS (REF. l) 


EPSITH 

EPSIPH 

GAPHTH 

XKTH 

XKPH 

XKPT 


e 

£ 

Y 

k 

k 

k 


6 

o 

4>e 

e 

* 

4>0 


o 
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SHPLAS 


( 


ENTER 




CALCULATE 

STRAINS 



UPDATE ALL VALUES TO CURRENT LOAD STEP. 
OBTAIN EQUILIBRIUM AND STRAIN CORRECTIONS. 
WRITE RESULTS ON TAPE X. 
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FOR, IS SHPL AS » SHPLAS 

SUBROUTINE SHPLAS ( NCYC .NAPEX.NPR, STEP ) 
INTEGER SAVJTC.SAVSTP.Q, THICK 
INTEGER XN 

DOUBLE PRECISION YPREO 
DOUBLE PRECISION YCORR 
C 


COMMON STORY ( 16 ) , XMATI 270, 10) , STDI 10) , SADUS (30) .RADUSI30 ) 

COMMON TADUS(30),UADUS(30),SAVTIC(900) 

COMMON XN.TEFREE, TIC, PHI, STOP, RESTOP, RTICK, G1.XNH3) ,NH 
COMMON NST ( 30 ) , NKL( 30 ) , NXMATI 20 ) , SAVJTC ( 30 ) , SAVSTP (30) ,JRTIC(30> 
COMMON JRSTOPI30 ).,NREG,NMPT ,NRC,NSC,NIX, IERROR, KGEOM , IGEOM, I STTAB 
COMMON KELVIN, IBEGIN,NPROB,NSEG,NERROR,Q,THICK,NOJS, NLINKS,NLCASE 
' COMMON NTSKL.NZ ,NBCT,L INPUT ,NTRKL ,NPASS • XN1 ,KBC »NRINGS 
COMMON LODE, ICYCLE,LDISTL 

COMMON /LASTEQ/ YPREDI8 ) , YOOT ( 8 ) , YASAVE ( 8) , 

1 YANTH.YAMTH, YAMPT, YANPT, YAOPH, YAQPH, YAQTH, YAJPH, 

2 S,SN,CS , SNSO.CSSQ, TAN, SEC.CN , X1CS, XI SN ,TN, 

3 X1RO*X1ROSQ,X 1SNR0 , X 1CSR0.CN1R0, SN1R0.CS1R0, 

4 X 1R 1, X 1R 2, CS1R 1,CS1R2,SN1R1,X1R1SQ, R2SQ.R0, BE SQ, 

5 ROSQ, XNSO, BETA, R1,R2, SI, R1D0T, RISC, 

6 XNTTH,XNTPH,XMTTH,XMTPH,XFTHLL',XFPHLD, XF 2ELD, 

7 XMTHLO.XMPHLD.ETHET.EPHI ,XGPT,ALPHTH .ALPHPH, 

8 XNUTP ,XNUPT , XC 1 1 • XC22 ,XC 15 , XD33 , XD22 ,XD21,XD12« 

9 XK11,XK12,XK21,XK22,XK33,XD11, 

A M, I, S IT IN, SI TOUT , SI P IN, SI POUT.TPT IN .TPTOUT , 

6 ZBR IN, Z8R0UT, SCR IPA , SCR IPI , SIF I N,S IFOUT ,TZEPH,TZETH 

B , XNPH I , B ETTA, Z ETTA, XC 16 < 

C ,RMOSS,RMOSN, YLOST , ROC , HP, FPLUH ,GPLUH, TWON 

0 , RMOSSY • RMOSN Y.RMOSXY.RMONXY 

D , RMOSNS » RMOSSS , S IGOXS, RMOSNR , RMOSSR, SI GOXR 

COMMON /MOOD/ SAVY( 53 ) ,NPLEV,NLPO,NPLA( 21 ) , STR ( 6 > , SI GMAI3.21 > , 

C SEPS(3,21),SALPH(3,21),SBAPH(3,21),STEPS(3,21i, 

O EFF ( 21 ) , STSRNI 3 ),NPLAST(3)*STSIG(3),STREPS(3), 

M STALPH(3),STBAPH(.3),EFFST(3),NPLEVS(3) 

COMMON /CDISP/ P,PMAX ,DELP ,DELP1 , YEPS.ZEPS 

COMMON /CMAIN/ ZETA1 ( 21 ) ,ZETA2 ( 21 ) .NODE , ALF ( A ) ,CE I 4) ,NLRS , HI ,H0, T 
COMMON /PLSTIC/ 10, JO, IOR, JOR.KOR I ,NEO 
COMMON /MAGIQ/ KKNT,T I I , T IK, TOK, TOO 

COMMON /RMO/ ER . ES.CPH.C TH, APH, ATH, SPH, STH, ALPHS, ALPHR.TS.TR.SNB, 

C CSB 

COMMON /GRAF IX/ X( 100 >,Y( 100, 9 > .NGRAPH, LDEF ( 9) ,NGR ,JCYC , NFLAG, JAM, 
C JNSC 

DIMENSION SAVX(53),EPSTNT<3,2) 

DIMENSION DSTR(6),EPSINT(3,2),TEMP(7),DSIG(3),DEPS(3),TEPS(3) 
DIMENSION YCORR ( 16 ) 

DIMENSION SIGMI ( 3 ) , SIGMO (3),EPSI(3),EPS0(3) 

DIMENSION OTOT(3),EE(2),DEN(3),DEM(3) 

EQUIVALENCE < DSTR( 1) , EPS IPH ) , ( OSTR < 2 ) ,E PSI TH ) , <OSTR( 3 ) .GAPHTH) 
EQUIVALENCE (OSTR ( 4 ) , XKPH ) , (DSTR ( 5 ) ,/KTH) , ( DSTR (6 ) ,XKPT ) 
EQUIVALENCE ( YPRED( 1 ) , YCORR ( 1 ) ) 

EQUIVALENCE (NERR.NIX) 

EQUIVALENCE (XNL( 1 ) , XI » , ( XNL ( 2 ) , X2 ) , (XNL ( 3 ) , X3 ) 

EQUIVALENCE (RMOSSX.RMOSS I , ( RMOSNX, RMOSN ) 

13 FORMAT ( 1H0.40X, 35HSTRAINS AND STRESSES SHELL ELEMENTS) 

30 FORMAT ( IHO, 45X, 4HN0DE, 1 5 , 10H OF MEMBER , 1 5, 12H NOT CM DISK) 

50 FORMAT ( 1H0 , 50X, 35HERR0R IN LINEQU IN EPSIS CYCLE » ,F6.0) 

55 FORMAT ( 1H0 , 50X, 35HERR0R IN LINEQU IN SEPSIS CYCLE * ,F6.0) 

60 FORMAT ( 1H0 , 50X, 35HERROR IN LINEQU IN ORTHKN CYCLE = ,F6.0) 

JDISK = 6 


3300010 

3300020 

3300030 

3300040 

3300050 

3300060 

3300070 

3300080 

3300090 

3300100 

3300110 

3300120 

3300130 

3300140 

3300150 

3300160 

3300170 

3300180 

3300190 

3300200 

3300210 

3300220 

3300230 

3300240 

3300250 

3300260 

3300270 

3300280 

3300290 

3300300 

3300310 

3300320 

3300330 

3300340 

3300350 

3300360 

3300370 

3300380 

3300390 

3300400 

3300410 

3300420 

3300430 

3300440 

3300450 

3300460 

3300470 

3300480 

3300490 

3300500 

3300510 

3300520 

3300530 

3300540 

3300550 

3300560 

3300570 

3300580 

3300590 
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vS IMP*. 3333333/1 NLPO-l) 

II a I 
IA * 1 

IF (NH.EQ.O) GO TO 180 

IF (LOISTL.EQ.l) GO TO 112 

IF (KELVIN. EQ.l. OR. KELVIN. EQ. 31 GO TO 110 

DO 111 K=1,KBC 

DO 111 J*l,3 

111 STEPS(J.K) * 0.0 
GO TO 112 

110 IF (THICK. NE.1I GO TO 113 
NLH * NLRS/2+1 
DO 115 LR*1 . NLH 

TT * T0K*2.0*ZETA1(LR)*(TII-T0K) 

STEPS ( 1 , LR ) * ALPHPH*TT 
STEPS ( 2. LR ) * ALPHTH*TT 

115 STEPS ( 3, LR) = 0.0 
NLH = NLH+1 ‘ 

DO 116 LR*NLH, NLPO 

TT = TQK+2.0*ZETA 1( LR )*( TOK-TOO) 

STEPS ( 1 • LR > * ALPHPH*TT 
STEPS ( 2, LR ) = ALPHTH*TT 

116 STEPS( 3* LR ) * 0.0 
GO TO 112 

113 DO 200 K=l»2 

DO 200 LR-l.NLPO 
LRT = LR-f ( K-l ) *NLPO 
GO TO ( 300.400 >*K 
300 TT - TlK-»ZETA2(LR)*(TII-TIK) 

GO TO 500 

400 TT * TOK+ZET A2( LR )*( TOO-TOK I 
500 STEPS(l.LRT) * ALPHPH*TT 
STEPS ( 2 • LRT ) = ALPHTH*TT 
200 STEPS ( 3.LRT ) * 0.0 

112 CONTINUE 

IF (DELP/ABS(DELP).EQ.OELP1/ABS(OELP1>> GO TO 180 
DO 181 K*1,KBC 
NPLA(K) * 0 
DO 181 J*i,3 

181 SBAPH(J.K) * SIGMA! J.K) 

DO 182 J=l,3 

NPLAST ( J ) = 0 

182 STBAPHIJ) = STSIG(J) 

180 CONTINUE 

IF ( NAPEX.EQ.O.OR. ( NH.NE .0. AND . IBEGIN.NE.l) I GO TO 49 
IF (NPR.EQ.O) GO TO 49 
IF (PHI. NE. TIC) GO TO 49 
WRITE (6*42 ) 

42 FORMAT (//20X, ’THIS IS AN APEX SEGMENT' > 

49 CONTINUE 

356 GO TO (1781. 1782, 1783 ),IGEOH 
C PHI COORDINATE 

1781 EPSITH*XIR0*(YC0RR( IL+5 1 *CS-YCORR( IL+6 )*SN ) 

1 +X16YA0PH*SAVY(9) 

EPSIPH*X 1RI* ( YOOT I 1L+5 ) - YCORR( IL+6 ) ) 

1 +X1*YC0RR( IL-*-7)*SAVY(5) 

GAPHTH = Y00T(IL*4)*X1R1 - ( YCORRI IL*4) *CS>* X1R0 

1 ~X1*(YA0PH*SAVY(5)+YC0RR( IL+7 >*SAVY(9 ) ) 

XKPH = YOOT (IL>7)6X1R1 
XKTH = X 1R0* YCORRI IL+7XCS 
. XKPT * X1RO*0.5*(2.0*YAOPH*CS*X1R1*( 

" 1 17S 


3300600 

3300610 

3300620 

3300630 

3300640 

3300650 

3300660 

3300670 

3300680 

3300690 

3300700 

5300710 

3300720 

3300730 

3300740 

3300750 

3300760 

3300770 

3300780 

3300790 

3300800 

3300810 

3300820 

3300830 

3300840 

3300850 

3300860 

3300870 

3300880 

3300890 

3300900 

3300910 

3300920 

3300930 

3300940 

3300950 

3300960 

3300970 

3300980 

3300990 

3301000 

3301010 

3301020 

3301030 

3301040 

3301050 

3301060 

3301070 

3301080 

3301090 

3301100 

3301110 

3301120 

3301130 

3301140 

3301150 

3301160 

3301170 

3301180 

3301190 

3301200 



1 YDOT I IL+* ) * SN ♦ YCORRI IL+*) * CS )) 

GO TO 1785 
C CONE 

1782 EPSITH = ll.O/tS*CS)> * ( +YCORRI IL+5I*CS-SN*YC0RRIIL*6> ) 

1 ♦Xi*YA0PH*SAVYI9l 

EPSIPH= YDOTIIL+5) 

1 +Xl*YCORRI IL+7)*SAVYI5) 

GAPHTH = YOOT ( IL**) - 1.0/1 S*CS) * ( ♦CS * YCORRIIL**)) 

1 -Xl*l YAOPH*SAVYI 5 UYCORRC IL+7)*SAVYt 9) ) 

XKPH = YDOTIIL+7) 

XKTH = l.O/IS+CS) * YCORRI IL + 7) * CS 
XKPT = l.O/l 2.0*S+CS )*l 2.0*YA0PH*CS+ 

1 YDOTIIL+*) * SN) 

GO TO 1785 
C CYLINDER 

1783 EPSITH= X1R0* I - YCORRI IL+6)) 

1 +X1*YA0PH*SAVYI9> 

EPSI PH= YDOTIIL+5) 

1 +X1*YC0RRI IL+7 )*SAVYI 5 ) 

GAPHTH= YDOT ( IL+*) 

1 — Xl*l YAOPH+SAVYI 5 l+YCORRI IL+7 )*SAVY| 9 ) ) 

XKPH * YOOT I IL+7) 

XKPT * 0 .5*X 1R0+Y00TI IL + * ) 

XKTH =0.0 
1785 CONTINUE 
280 CONTINUE 

CE(l) = EPHI/ll.O-XNUTP’+XNUPT) 

CE (2 ) = ETHET/I 1.0-XNUTP+XNUPT ) 

CE 1 3 ) = XGPT 

CE (9) = XNUPT+EPHI/I 1 .0— XNUTP*XNUPT ) 

ALFI1) = 1.0/EPHI 
ALFI2) = 1.0/ETHET 
ALFI3) = 1.0/XGPT 
ALFI*) = -XNUPT/ETHET 
C INITIALIZE EPSINT ARRAY 

285 DO 290 JJ = 1,3 
DO 290 JT = 1,2 
290 EPSINTIJJ.JT) = 0.0 
C 

LIM = 2 

IF ITHICK.EQ.il LIM = 1 
00 3800 IS=1,LIM 
DO 2911 JJ=1,3 
DO 2911 JT= 1 ,2 
2911 EPSTNTI JJ, JT ) * 0.0 
DO 380 LR = l.NLPO 
LRT = NLPO+I IS-l )+LR 
GO TO 12901, 2902), LIM 

2901 TEMPI*) = ZETAHLR1+H 1/2.0 
GO TO 292 

2902 GO TO 12903,290*), IS 

2903 TEMPI*) = ZETA2 I LR ) *HI+I 2.0*T*HO+H0*H0-HI*HI ) /2 . 0/ IH I+HO ) 

GO TO 292 

290* TEMPI*) = ZETA2 1 LR ) *H0— I 2 .0*HI*I HO+T )+HI*HI +HO*HO) /2.0/IHI+H0) 

292 DO 293 11=1,3 

293 TEPSIII) = DELP*STEPSI II.LRTI 
C 

CALL SHSRSE I DSIG, TEMP, DSTR , 1 , TEPS ) 

IFINPLEV . EQ.O) GO TO 395 
C 

315 TEMPI 5 ) = SIGMA! l.LRT l-SALPHI l.LRT) 


3301210 

3301220 

3301230 

33012*0 

3301250 

3301260 

3301270 

3301280 

3301290 

3301300 

3301310 

3301320 

3301330 

33013*0 

3^01350 

3301360 

3301370 

3301380 

3301390 

3301*00 

3301*10 

3301*20 

3301*30 

3301**0 

3301*50 

3301*60 

3301*70 

3301*80 

3301*90 

3301500 

3301510 

3301520 

3301530 

33015*0 

3301550 

3301560 

3301570 

3301580 

3301590 

3301600 

3301610 

3301620 

3301630 

33016*0 

3301650 

3301660 

3301670 

3301680 

3301690 

3301700 

3301710 

3301720 

3301730 

33017*0 

3301750 

3301760 

3301770 

3301780 

3301790 

3301800 

3301810 


17 « 



TEMPI6) = SIGMA I2«LRT)-SALPH|2,LRT) 

TEMPI? ) = SIGMA! 3,LRTI— SALPHI3.LRT) 

IF I NPLAILRT ) .LE.O ) GO TO 375 

IF IGPLUH*TEMPI5)*DSIGI1 )+FPLUH*TEMPI6) *DSIGI 2 )-HP*l TEMP (5)* 

1 DSIGI2)*TEMPI6)*DSIGI1) ) ♦TWON*TEMP 1 7 )*OSIG ( 3 ) .LT.ZEPS) GO TO 370 
00 318 JJ= 1* 3 

318 TEMPI JJ ) = TEMPI JJ)-TEPSIJJ) 

IF IKORI.GT.O) GO TO 319 

IF I RM0SN.EQ.-1.0 ) GO TO 320 

CALL SEPSIS ITEMPtOEPS, SIGMA, DSIG , SEPS, SALPH ,SBAPH,L RT ,NERR, 

1 RMOSN,RMOSS,ROC,YLDST,EFF,KORI ) 

IFINERR . EQ.O) GO TO 335 
WRITEI JDISK.55) P 
GO TO 980 

319 IF I RMOSNX. EQ.0.0 ) GO TO 320 

CALL ORTHKN I TEMP.DEPS, DS IG.LRT , ALF ,NERR ) 

IF INERR.EQ.O) GO TO 335 
WRITEI JDISK.60) P 
GO TO 980 

320 CALL EPSIS I TEMP., OEPS. SIGMA, DSIG, SEPS, LRT ,NERR,GPLUH .FPLUH.HP, 

1 TWON) 

IFINERR .EQ.O) GO TO 335 
WRITEI JDISK, 50) P 
GO TO 980 

335 IFILR . EQ. 2* I LR/2 ) ) GO TO 360 

IFILR .EQ. 1 .OR. LR .EQ. NLPO ) GO TO 350 
00 340 JJ = 1,3 

EPSTNT I JJ, 1 ) * EPSTNTIJJ,1)+2.0*DEPSIJJ> 

340 EPSTNT I JJ,2) • EPSTNT I JJ ,2 ) *2.0*TEMP I4)*DEPS I JJ ) 

GO TO 380 

350 00 355 JJ =1.3 

EPSTNT I J J . 1 ) » EPSTNT I J J , 1 1+OEPS I JJ ) 

355 EPSTNT I J J . 2 ) = EPSTNT I J J , 2 ) +TEHPI 4 )*DEPSI JJ > 

GO TO 380 

360 00 365 JJ * 1,3 

EPSTNT I J J . 1 ) = EPSTNTIJJ.l )+4.0*DEPSIJJ ) 

365 EPSTNT! JJ, 2) = EPSTNT I J J ,2 ) ♦4.0*TEMP 14 ) *DEPS I J J ) 

GO TO 380 

370 NPLAILRT) = -LRT 
375 DO 378 JJ = 1,3 

SIGMA! JJ, LRT) = S IGMA I J J , LRT ) +DSIGI J J ) 

378 TEMPI JJ+4 ) * TEMPIJJ+4) ♦ DSIG(JJ) 

YCOND * YEPS 

IF IKORI.EQ.O) YCONO = YCOND*EFF I LRT )*EFF ILRT ) / YLDST 
IF IGPLUH*TEMP( 5 ) *TEMPI 5 )+FPLUH*TEMP I6)*TEMPI6)-2.0*HP*TEMPI5)* 

1 TEMP I 6 )+TW0N*TEMPI7 ) *TEMPI 7) ,GE .YCOND) NPLAILRT) = LRT 
GO TO 380 
395 CONTINUE 

DO 398 JJ=!,3 

398 SIGMA! JJ, LRT) = S IGMA I J J ,LRT I+DSIGI J J) 

TEMP ID * GPLUH* SIGMA 1 1 , LRT ) *SIGMAI 1 ,LRT )-*-FPLUH*SIGM Al 2,LRT ) * 

1 SIGMA! 2 ,LRT )-2.0*HP*S IGMAI 1 , LRT ) *S IGMA 1 2,LRT ) + TWON*SIGHA (3 ,LRT )* 

2 SIGMA I 3, LRT) 

IF I TEMPI! ) .LT. YEPS ) GO TO 380 
NPLAILRT) = LRT 
NPLEV = 1 
380 CONTINUE 

GO TO 13801,3802), IS 
3801 00 385 JJ=1, 3 

177 1 


3301820 

3301830 

3301840 

3301850 

3301860 

3301870 

3301880 

3301890 

330190Q 

3301910 

3301920 

3301930 

3301940 

3301950 

3301960 

3301970 

3301980 

3301990 

3302000 

3302010 

3302020 

3302030 

3302040 

3302050 

3302060 

3302070 

3302080 

3302090 

3302100 

3302110 

3302120 

3302130 

3302140 

3302150 

3302160 

3302170 

3302180 

3302190 

3302200 

3302210 

3302220 

3302230 

3302240 

3302250 

3302260 

3302270 

3302280 

3302290 

3302300 

3302310 

3302320 

3302330 

3302340 

3302350 

3302360 

3302370. 

3302380 

3302390 

3302400 

3302410 

3302420 



00 385 JT=1 , 2 

385 EPSINTt JJ,JT) 
GO TO 3800 

3802 DO 386 JJ=1,3 
DO 386 JT=1»2 

386 EPSINT I J J, JT ) 
3800 CONTINUE 

00 435 JJ=1,6 
435 STRIJJ) 

DENPT « 

DENPH * 

DENTH = 

DENPH x 
DENTH = 

DENPT * 

GO TO 


= EPS INTI JJ, JTJ+EPSTNTIJJ,JT)*SIMP*HI 


= EPS INTI JJ,JT)*EPSTNTCJJtJT)*SINP*HO 


STRIJJ) + DSTRIJJ) 

« 0.0 
= 0.0 
= 0.0 
= 0.0 
=> 0.0 
* 0.0 

15000* 5000, 5000. 5250, 5250. 5250,5500. 5500, 5500, 5750,5750, 


1 5750 ) , ISTTAB 

: SMEARED RINGS AND STRINGER PLASTICITY 

5750 IF IAPH.EQ.0.0) GO TO 5850 
OTOTtI) = EPSITH-CPH*XKPH 
STSRNI 1 ) = STSRNI 1 ) ♦OTOT 1 1 ) 

DTOTU) = DTOTU ) -DEL P*AL PH S*TS 

CALL SNEAR I ES, NPLEVS 1 1 1 .NPLASTIl) , STS IG ( 1 ) , STALPH II > .RMOSNS, 

1 STREPS 1 1 ) , RMOSSS, S IGOXS, STBAPH 1 1 ) ,EFFSTI 1 ) , DENPH, 

2 DENPH, SPH.CPH, DTOTU), APH) 

5850 IF I ATH. EQ.0.0 ) GO TO 5000 

0T0TI2I « EPSITH-CTH*XKTH 
STSRNI 2 1 * STSRNI2DDT0TI2) 

DT0TI2) * DTOTI 2 )-0ELP*ALPHR*TR 

CALL SMEAR I ER, NPLEVS 1 2 J .NPLASTI 2 ) , STSIG (2 1 .STALPH 12 ) , RMOSNR, 

1 STREPS! 2 1 .RMOSSR.SIGOXR, STBAPH I 2),EFFSTI2) .DENTH, 

2 DENTH, STH.CTH, OTOT I 2 ) , ATH) 

GO TO 5000 

C WAFFLE PLASTICITY 

5250 IF IATH. EQ.0.0) GO TO 5000 
DTOTU) = EPSIPH— CPH*XKPH 
DT0TI2) *. EPSITH— CPH*XKTH 
DTOTI 3) = GAPHTH-2. 0*CPH4XKPT 

EE ID * OTOT I D -CSB*CSB+0T0T I 2 )*SNB*SNB+DTOTI 3 ) *SNB*CSB 
STSRNI 1 ) = STSRNI 1 ) *EEI 1 ) 

EE ID * EE 1 1 )-DELP*ALPHS*TS 

EE 12 I = DTOT I D *SNB*SN8+OTOT 1 2 )*C5B*CSB-DT0T 1 3 > *SNB*CSB 
STSRNI 2 ) = STSRNI 21+EEI 2 ) 

EE 12 ) * EE 1 2 )-OELP*ALPHS*TS 
DO 5300 11=1,2 

CALL SMEAR I ES, NPLEVS 1 1 D .NPLAST I 1 1 ) , STSIG 1 1 1) , STALPH I II ) , RMOSNS , 

1 STREPS I 1 1 )• RMOSSS, S IGOXS, STBAPH! 1 1 ) , EFFS T 1 1 1 ) , DENI 1 1) , 

2 OEM! I I), SPH.CPH, EE! I I I, APH) 

5300 CONTINUE 

DENPH = I DEN 1 1 )*CSB*DEN I 2 )*SNB I/ICSB+SNB) 

DENTH = (DENU)*SNB + DENI2)*CSB)/tCSB+SNB) 

DENPH = OENPH*CPH 

DEMTH = DENTH*CPH 

DENPT = I DEN 1 1 I-0ENI2 ) 1/2.0 

DENPT * DENPT4CPH 

GO TO 5000 

: ISOGRID PLASTICITY 

5500 IF IAPH. EQ.0.0) GO TO 5000 
OTOT ID = EPS IPH-CPH*XKPH 
DTOTI 2 ) •= EPSITH— CPH*XKTH 
DT0TI3) = GAPHTH-2. 0*CPH*XKPT 


3302430 
3302440 
3302450 
3302460 
3302470 
3302480 
3302490 
3302500 
3302510 
3302520 
3302530 
3302540 
3302550 
3302560 
3302570 
3302580 
3302590 
3302600 
3302610 
3302620 
3302630 
3302640 
3302650 
3302660 
3302670 
3302680 
3302690 
3302700 
3302710 
3302720 
3302730 
3302740 
3302750 
3302760 
3302770 
3302780 
3 302790 
3302800 
3302810 
3302820 
3302830 
3302840 
3302850 
3302860 
3302870 
3302880 
3302890 
3302900 
3302910 
3302920 
3302930 
3302940 
3302950 
3302960 
3302970 
3302980 
3302990 
3303000 
3303010 
3303020 
3303030 
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TEMP ( l ) = 10T0TUK0T0T12) >/2.0 
TEMPI 2 ) = I OTOT I 2 )-OTOTI 1) ) / 2 .0 
TEMPO) = DT OT < 2 ) 

OTOT(l) = TEMP( 1 ) -TEMPI 2 )*COS ( 2.0*BETTA ) ♦DTQTI 3 ) /2.0*SIN(2.0* 

1 BETTA) 

STSRNI1) * STSRNI 1 )+0T0T ( 1 ) 

DTOT(l) = DTOT! l l-DELP*ALPHS*TS 

DTOT 1 2 ) = TEMP) 1 ) -TEMPI 2 )*COS 12.0*BETTA)-DTDTI3)/2.0*SINI2.0* 

1 BETTA) 

ST SRN ( 2 ) = STSRN( 2)+0T0T (2 ) 

DT OT ( 2 ) = DTOT I 2 )-DELP*ALPHS*TS 
DT OT ( 3 ) = TEMPO) 

STSRNI3) = STSRNI 3 ) ♦DTOT l 3 ) 

DT OT ( 3 ) = DTOT O ) -DELP*ALPHS*TS 
DO 5525 11*1.3 

CALL SMEAR ( ES, NPLEVS .NPLASTUI ) , STS IG III ) « STALPH( II ) , RMOSNS . 

1 STREPS) 1 1 > » RMOSSS* SIGOXS. STBAPHl 1 1 ) . EFFSTI 1 1 ) .OEN(II). 

2 DEM( 1 1 ) .SPH. CPH.DTOT ( 1 1 ) . APH ) 

5525 CONTINUE 

DENPH « <0ENU)*C$B+DENI2)*CSB)/2.0/SNB 
DENTH = IOENI 1J*SNB+DENI 2 )*SNB+2 .0*DENI 3 ) > /2 . O/CSB 
DENPT = < OENI 1I-DENI2) 1/2.0 
DEMPH = OENPH*CPH 
OEMTH = DENTH*CPH 
DEMPT = OENPT*CPH 
GO TO 5000 
5000 CONTINUE 

SAVX(l) = SAVYI U+YPREDI 1+5) 

SAVXI2) = SAVYI2I+YD0TI 1+5) 

SAVXI3) = SAVYI 31+YPREOI 1+6) 

SAVXI4) * SAVY14)+YD0TI 1+4) 

SAVXI5) = SAVYI 5 ) ♦YPREDI 1+7 ) 

SAVXI6 ) = S AVYI 6 )+YPREDI 1 + 1) 

SAVXI7 ) = SAVY 17) ♦YANTH 
SAVXI8) = SAVYI 8 l+YANPT 
SAVXI9) = SAVYI 9 ) ♦YAOPH 

SAVXI 10) = CEI2)*IEPSINTI2» 1 )+XNUTP*EPSINT 1 1 . 1 ) ) 


S AVX 111) 

1 

SAVXI 12) 

1 

SAVXI13) 

1 

SAVXI 14) 

1 

SAVXI 15) 

1 

SAVXI 16) 
SAVXI 17 ) 
SAVXI 18 ) 
SAVXU9) 
SAVXI 20 ) 
SAVXI 21 ) 
SAVXI22 I 
SAVXI23) 
S AVX 124) 
SAVXI25) 
SAVXI 26 ) 
SAVXI 27 ) 
SAVX128) 


+DENTH 

* CEU)*<EPSINTtl,l)+XNUPT*EPS INTI 2,1) ) 
+DENPH 

* XGPT*EPS INT 13.1) 

♦DENPT 

= CEI2)*IEPSINTI2,2) ♦XNUTP*EPS INT ( 1,2) ) 
♦DEMTH 

= CEI1)*IEPSINTI1,2 ) ♦XNUPT*EPS INT (2.2)) 
♦DEMPH 

* XGPT *EPSINTI3,2) 

♦DEMPT 

= SAVYI 16I+YPRE0II) 

= SAVY I17I+YPREDII+2) 

= SAVY I18)*YPRE0II*3) 

= SAVY 1 19 ) ♦YPREDI 1*4 ) 

= SAVY I 20 ) +YAMTH 

* SAVYI 21 •♦YAMPT 
= EPSITH 

x XKTH 

= SAVY I24)+0ELP*XFTHL0 

* SAVY 1 25 ) ♦OELP*XFPHLD 
= SAVY I26)+0ELP*XFZELD 
= SAVY I 27 ) ♦OELP*XMTHLD 
= SAVY 1 28 ) ♦DELP*XMPHLD 


3303040 
3303050 
3303060 
3303070 
3303080 
3303090 
3303100 
3303110 
3303120 
3303130 
3303140 
3303150 
3303160 
3303170 
3303180 
3303190 
3303200 
3303210 
3303220 
3303230 
3 303240 
3303250 
3303260 
3303270 
3303280 
3303290 
3303300 
3303310 
3303320 
3303330 
3303340 
3303350 
3303360 
3303370 
3303380 
3303390 
3303400 
3303410 
3303420 
3303430 
3303440 
3303450 
3303460 
3303470 
3303480 
3303490 
3303500 
3303510 
3303520 
3303530 
3303540 
3303550 
3303560 
3303570 
3303580 
3303590 
3303600 
3303610 
3303620 
3303630 
3303640 
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SAVXI29) = SAVY(29)4YD0T< I ) 

SAVXI30) = SAVV(30)+YDOT<I-H) 

SAVXI31) * SAVY(31)4YD0T(I42> 

SAVX( 32) = SAVYI32)4YD0T<I*3) 

00 120 J=6,8 

120 IF ( ABSISAVXIJ) J.LT.l.E-5) SAVX(J) = 0.0 
DO 121 J=10, 18 

121 IF (ABSISAVXIJ) ).LT.l. £-5) SAVXI J) = 0.0 
DO 122 J=20'21 

122 IF ( ABS I SAVX I J ) J.LT.l.E-5) SAVXIJ) =0.0 
CALL SAVXES (SAVX) 

WRITE I JO) S AVX«NPLEV,NPLA,S IGMA, SAL PH. SBAPH, STEPS, ST R» EFF » STSRN, 

1 NPLAST.STSIG, STREPS, STALPH.STBAPH.NPLE VS, EFF ST, SEPS 

IF (NH.NE.O. AND. IBEGIN.NE . 1. ANO.NGR »EQ. 0 ) GO TO 980 
IF (NPR.EQ.O.ANO.NGR.EQ.O) GO TO 980 
THK = 0.0 
DO 540 J = 1 » 3 
SIGMIIJ) = 0.0 
SIGMOIJ) =0.0 
EPSKJ) = 0.0 
590 EPSOIJ) = 0.0 

GO TO <158. 131, 158, 152, 153, 159, 152,153, 154, 152, 153,1 54 ) , I STTA8 
131 GO TO (152, 153, 154, 158), THICK 

152 THK = HI 

DO 542 J=l,3 

SIGMOIJ) = SIGMA! J.NLPO) 

EPSKJ) * STR(J)+HI/2.0*STR(J43) 

542 EPSO(J) = STRCJ )-HI /2.0*STR I J*3 ) 

EPSII3) = EPSI(3)+HI/2.0*STR(6) 

EPSOI 3 ) = EPSO( 3 )-H I/2.0*STR( 6 ) 

GO TO 157 

153 THK = T*2.0*HI 
GO TO 155 

154 THK = T+HI+HO 

155 CONTINUE 

2ETAI = (HI*HI+HO*H042.0*HI*HO+2.0*HO*T)/<2.0*«HI+HO)) 

ZETAO = (HI*HI+HO*HO*2.O*HI*H0+2.0*HI*T)/<2.0*(HI+HD)> 

DO 543 J=l, 3 

SIGMOIJ) = SIGMA! J,NLP0*2) 

EPSI(J) = STR(J)+ZETAI*STR( J43J 

543 EPSOIJ ) = STR(J)-ZETA0*STR(J43) 

EPSI < 3) = EPSI(3)+ZETAI*STR(6) 

EPS0<3) = EPSOI 3)-ZETA0*STR(6) 

157 DO 541 J= 1, 3 

541 SIGMKJ) = SIGMA! J, 1 ) 

158 CONTINUE 

IF (NGR.EQ.l ) CALL ARRAYS I SAVXI 19) , SA VX 1 1 ) , SAVX 13 ) , SI GMI (2 1 , 

1 SIGMI(l),SIGMI(3),SIGMO(2), SIGMOIl), SIGM0I3), PHI) 

IF (NPR. EO.O .OR. IBEGIN.NE.l) GO TO 980 
DEGRES = 0.0 

IF (IGEOM.EQ.l) DEGRES = PHI*57. 29578 

WR ITE 1 6, 7001 ) PHI, DEGRES, RO, THK, STEP, EPSII2) , 

1 STR(2),STR(1),(STR< I ) , 1 = 3, 5) , EPSO 1 2 ) , 

2 SAVXI 19KSTR(6),SAVX(7),SAVX<6),SAVX<8),EPSI(1), 

3 SAVX(l), SAVX (17), SAVX(20),SAVX(18),SAVX(21),EP SO(l), 

4 SAVXI 3) .SAVXI 16 ) , S IGM 1 1 2 ) , SIGM 1 1 1 1.SIGMI 1 3), EPSI (3) , 

5 SAVXI 5 ) ,SAVX( 9) , SIGMOI 2 ) , S IGHO 1 1 ) .SIGMOI 3) .EPSOI 3) 
7001 FORMAT (////( 3X.6I1PE14. 7, 7X))) 

IF I NPLEV . EQ .0 ) GO TO 515 

WR ITE (6,519) (NPLAI NL ) ,NL=1,KBC ) 

519 FORMAT I // • NPLA =*,8X,21I5) 


3303550 

3303660 

3303670 

3303680 

3303690 

3303700 

3303710 

3303720 

3303730 

3303740 

3303750 

3303760 

3303770 

3303790 

3303800 

3303810 

3303820 

3303830 

3303840 

3303850 

3303860 

3303870 

3303880 

3303890 

3303900 

3303910 

3303920 

3303930 

3303940 

3303950 

3303960 

3303970 

3303980 

3303990 

3304000 

3304010 

3304020 

3304030 

3304040 

3304050 

3304060 

3304070 

3304080 

3304090 

3304100 

3304110 

3304120 

3304140 

3304150 

3304160 

3304170 

3304180 

3304190 

3304200 

3304210 

3304220 

3304230 

3304240 

3304250 
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HR ITE(6 « 517 ) ( « S IGMA ( L3, NL I , L 3 = 1 , 3 I ,NL = 1 ,KBC > 3304260 

517 FORMAT ( / * SIGMA = • t 7X. 1P9E 13. 5/1 15X, 1P9E 13. 5 > > 3304270 

HR ITE (6 1 518 ) ( ( SEPS ( L3*NL )«L3=1>3)> NL= 1 * KBC 1 3304280 

518 FORMAT!/* EPSILON PLAS = • , 1P9E 13. 5/ I 15X , 1P9E 13. 5 )) 3304290 

515 CONTINUE 3304300 

980 RETURN 3304310 

END 3304320 
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FOR* IS SHSRSE * SHSRSE 

SUBROUTINE SHSRSE < OS IG, TEMP, STR.LL .EPS ) 

COMMON /CMAIN/ ZETA 1< 21 ) * ZETA2( 21 ) , NODE * ALF (4) ,CE(4) .NLRS.H1 .HO.T 
DIMENSION OS IG ( 3 ) «TEMP ( 4 ) * STR ( 1 ) *EPS(1)*ESR(3) 

IF (ISTTA8.NE.2) GO TO 640 
621 GO TO (610.650.650.640) * THICK 
610 CONTINUE 
650 CONTINUE 
640 CONTINUE 

TEMP(l) = STRCLL)-TENP(4)*STRUL+3) 

TEMP(2> = STRILL+l )-TEMP(4)*STR(LL*4) 

TEMPO) « $TR(U.*2)-2.0*TEMP(4»*STRUL*5) 

ESR(l)=TEMP(l)-EPS(l) 

ESR(2)«TEMP(2)-EPS(2) 

ESR(3)=TEMP(3)-EPSC 3) 

DSIG(l) = CE(1)*ESR( 1)*CE(4I*ESR<2) 

OS IG( 2 ) = CE ( 4 ) *ESR ( 1 ) +CE ( 2 )*ESR < 2 ) 

0SIGI3) = CEO) *ESR ( 3 » 

RETURN 

ENO 


3500010 

35OO02O 

3500030 

3500040 

3500050 

3500060 

3500070 

3500080 

3500090 

3500100, 

3500110 

3500120 

3500130 

3500140 

3500150 

3500160 

3500170 

3500180 

3500190 


182 



o o o 


FOR, IS SEPSIS, SEPSIS 

SUBROUTINE SEPSIS ( OTOT ,OEPS, SIGMA, DSI 6, SEPS, SALPH ,SBAPH,LR ,NERR, 
1 RMOSN,RMOSS,ROC,YLDST,EFF,KQRI) 

STRAIN HARDENING- SHELL ELEMENTS. 

COMMON /CHAIN/ Z ET All 21 » ,ZETA2( 21), NODE ,ALF ( 4) ,CE ( 4> ,NLRS,HI ,HO,T 
DIMENSION DTOTI 3 ) , DEPSI 3 ) , SIGMA! 3, 1),DSIGI3) , SEPS <3, 1 ), 

D SALPHI 3, 1 ) , SBAPHI3, 1 ) ,TEMP(3 ) ,SAG(3 ) ,R( 3» 3 ) ,CAPMI 31 
DIMENSION EFFI l 1 
DO 100 1*1,3 

SAGI I ) =S IGMA (I,LR)-SALPH(I,LR) 

100 TEMPI I)=SIGMAC I,LR)-SBAPH( I,LR» 

C CHECK FOR ISOTROPIC HARDENING 
IF IKORI.EQ.O) GO TO 301 
C CHECK FOR LINEAR STRAIN HARDENING 

IF IRMOSS.NE.O.O) GO TO 252 
OEN » ROC 
GO TO 254 
C NON LINEAR 

252 OEN = ROC*lRMOSS/SQRTITEHPJ 1 )* I TEMP < 1 )-TEMP 1 2 > l+TEMP 12 )*TEMP (2 > + 

1 3.0*TEMPI3I*TEMPI3) ) )**RHOSN 
GO TO 254 

301 IF IRMOSS.NE.O.O) GO TO 352 

DEN = - I RHOSN+1 .0 ) /RMOSN/ALFI 1 ) 

GO TO 354 

352 DEN * 2.333333/ALFI 1)/(RMOSN+1.0)*IRHOSS/EFF(LR) )**R MOSN 
354 DEN = OEN*EFFILR)*EFFILR) 

254 CAPM(1) = SAGI 1 )— 0 • 5* SAG I 2 ) 

CAPMI 2 )= SAG! 2)-0. 5*SAGl l ) 

CAPMI 3 )=3.0*SAGl 3 ) 

C FORM R MATRIX RELATING TOTAL STRAIN AND STRESS INCREMENT 
TEMPI l)=CAPMI ll/OEN 
Rt 1 ,1 ) = ALF(1)*TEMPU)*CAPM(1) 

Rl 2 , 1 ) = ALF ( 4 ) ♦TEMPI 1 ) *CAPM! 2 ) 

Rl 1,2 )=Rl 2,1) 

RI3.1)=TEMPl 1)*CAPMI3) 

RI1,3)=RI3,1) 

TEMPI 1 )=CAPMI 2) /OEN 

Rf 2,2) = ALF 1 2 ) ♦TEMP (1)*CAPMI2) 

RI3,2)=TEMPI 1)*CAPM(3) 

RI2,3)=RI3,2) 

Rl 3, 3 ) = ALFI3)*CAPM(3)*CAPMI3) /DEN 
C SOLVE SYSTEM FOR STRESS INCREMENT 

CALL LINEQUt R,DTOT, 3, 1, 3,NERR ) 

IFINERR.EQ.O) GO TO 260 
GO TO 990 

260 DSIGl 1)=DT0TI1) 

DSIGI2)=DT0TI2) 

DSIGI3)=DT0TI3) 

C PLASTIC STRAIN INCREMENTS 

TEMPI l)=CAPM(l)*OTOTl 1 > +CAPMI 2 )*DTOT l 2 ) +CAPM 13 )*DTOT 13) 

TEMPI 2 ) = TEMPI 1 )/YLDST 

IF IKORI.EQ.O) TEMPI 2 ) = 0.0 

TEMPI 1>=TEMPI1)/DEN 

DO 270 1=1,3 

DEPS 1 1 ) =CAPM 1 1 ) *TEMPI 1 ) 

SALPHI I ,LR ) = SAL PHI I ,LR J + SAGI I )*TEMP I 2 ) 

SlGMAI I,LR)=SIGMA( I,LR)+DSTG(I ) 

IF IKORI.EQ.O) EFFILR) = SORT ( SI GMAI 1»LR )**2+SIGHA 12 ,LR> **2- 
1 . SI GMAI 1»LR )*S IGMA ( 2, LR ) + 3.0* SIGMA 13 ,LR ) **2) 

270 SEPS I I,LR)=SEPSI I ,LR )+DEPSI I ) 


3600010 

3600020 

3600030 

3600040 

3600050 

3600060 

3600070 

3600080 

3600090. 

3600100 

3600110 

3600120 

3600130 

3600140 

3600150 

3600160 

3600170 

3600180 

3600190 

3600200 

3600210 

3600220 

3600230 

3600240 

3600250 

3600260 

3600280 

3600290 

3600300 

3600310 

3600320 

3600330 

3600340 

3600350 

3600360 

3600370 

3600380 

3600390 

3600400 

3600410 

3600420 

3600430 

3600440 

3600450 

3600460 

3600470 

3600480 

3600490 

3600500 

3600510 

3600520 

3600530 

3600540 

3600550 

3600560 

3600570 

3600580 

3600590 

3600600 

3600610 
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8888 CONTINUE 202440 

CALC ETRAP 202450 

STOP 202460 

END 202470 


8 


FOR, IS LINEQUtLINEQU 

SUBROUTINE LINEQUI A,Y,M,N,HID.NIX) 

DIMENSION AIMIO, MID), TIMID, l) 

Ml =» M - 1 
DO 150 K = 1 ,M1 
KP * K ♦ 1 
X * 0. 

DO 110 I > K»M 

IF (X - ABS(A( I,K) ) ) 100,110,110* 
100 X = ABS ( A ( I , K ) ) 

L * I 

110 CONTINUE 

IF (X ) 120,120,130 
130 DO 140 J = 1 ,M 
X = AIK, J ) 

A ( K, J ) = AIL, J ) 

140 A( L, J ) = X 

DO 143 J * 1,N 

X = YI K, J ) 

YI K* J ) * Y (L , J ) 

143 Y(L,J) = X 

DO 150 I » KP,M 

X = AII,K) / At K,K ) 

DO 146 J 31 1,N 

146 Y 1 1 , J) = Y( I , J) - Y(K,J)*X 
DO 150 J = KP,M 

150 A( I, J ) = At I , J ) - AIK, J ) « X 
T = ABS I A ( M, M) ) 

IF IT) 160,120,160 
160 DO 165 J = 1 , N 
165 YI M, J ) = YIM.J) / A I M,M ) 

K * M 

DO 180 I = l, Ml 
X *= 0. 

KP * K 
K = K-l 
DO 180 L«1,N 
00 170 J * KP.M 
170 X * X ♦ AIK, J ) ♦ Y I J, L ) 

180 YIK.L) = I YI'K, L ) - X ) / AIK,K ) 
NIX = 0 
OO TO 190 
120 NIX = -IKP-1) 

190 RETURN 
END 


3900010 

3900020 

3900030 

3900040 

3900050 

3900060 

3900070 

3900080 

3900090 

3900100 

3900110 

3900120 

3900130 

3900160 

3900170 

3900180 

3900190 

3900200 

3900210 

3900220 

3900230 

3900240 

3900250 

3900260 

3900270 

3900280 

3900290 

3900300 

3900310 

3900320 

3900330 

3900340 

3900350 

3900360 

3900370 

3900380 

3900390 

3900400 

3900410 

3900420 

3900430 


3900440 

3900450 
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FOR, IS ORTHKN.ORTHKN 

SUBROUTINE ORTHKN I OTOT, OEPS, DSI G.LR.ALF ,NERR ) 

COMMON /LASTEQ/ OUM( 124 1 ,RHOSSX, RMOSNX, YLDST ,ROC ,HP, FPLUH.6PLUH, 

C TMON,RMOSSY, RMOSNY, RMOSXY, RMONXY 

COMMON /WOOD/ S AVYI 53 1 , NPLEV.NLPO.NPLA C 21 > , STR 1 6 1 , SI GHAI 3,21 » , 

C SEPSI 3*21) .SALPHi 3,21) ,SBAPH(3,21) .STEPS 13, 21) , 

0 EFFI 21) .STSRNt 3) .NPLASTI 3 ) , STSIG 1 3) , STREPS (3) , 

M STALPH(3I,STBAPH(3),EFFST(3),NPLEVSI3) 

DIMENSION CAPMI A ) .TEMPI 3 ) ,DEPS (1),DSIG(1),R(3,3) ,ALF ( 1 ) , SAG! 3) 
DIMENSION OTOT(l) 

DO IOO 1=1,3 

SAG(I) = SIGMA! I,LR)-SALPHII,LR) 

100 TEMPI 1 1 = SIGMA! I,LR)-SBAPHI I,LR) 

SIGB * FPLUH*TEMPI2)**2*GPLUH*TEMPI l )**2-2.0*HP*TEMP tl)*TEMPI2)+ 

1 T WON* TEMP I 3 ) **2 

IF I RMOSSX . NE.O .0 ) GO TO 205 

CX=ALFI 1 ) * 1 1 .O-RMOSNX J/RMOSNX*! GPLUH**2*HP**2* IGPLUH—HP* **2) / 

1 GPLUH**2 
GO TO 210 

205 CX=RMOSNX*ALFl l)/2. 333333*1 SQRTl SIGB /GPL UH) /RMOSSX)** IRMOSNX-l.O) 
1 *1 GPLUH**2*HP**2*I GPLUH-HP 1**2 ) /GPLUH**2 

210 IF IRMOSSY.NE.O.O) GO TO 215 

CY=ALF I 2 ) * ( 1 .O-RMOSNY ) /RMOSNY* I FPLUH**2+HP**2* l FPLUH-HP ) **2 ) / 

1 FPLUH**2 
GO TO 220 

215 CY=RMOSNY*AL FI 2 )/2. 333333*1 SQRTI SIGB/FPLUH > /RMOSSY)**! RMOSNY-l.O ) 
1 *IFPLUH**2+HP**2+I FPLUH-HP 1**2 )/FPLUH**2 
220 IF I RMOSXY.NE.O.O ) GO TO 225 

CXY=0.5*ALFl 3)*I l.O-RMONXY J/RMONXY 
GO TO 230 

225 CX Y=RMONXY*ALF I 31/4.6666667*1 SORT! SIGB/TWON) /RMOSXY) **IRMONXY 
1 fl.O) 

230 ONDC=!GPLUH*SAGI 1 )**2-HP*SAGI 1)*SA6I2) )*CX+ I FPLUH* SAG 1 2 ) **2 
1 ~HP*SAGI 1 ) *SAG( 2 ) ) *CY>TWON*SAGI 3 ) **2*CXY 
240 CAPMU) = 2 .0*1 GPLUH*S AGI 1 ) -HP* SAG I 2 ) ) 

CAPMI2) = 2.0*1 FPLUH*SAG( 2)-HP*SAG(l)> 

CAPMU) = 2.0*TW0N*SAGI 3 ) 

CAPM14) = -2 .0* I ( FPLUH-HP )*S AG 1 2 ) ♦! GPLUH-NP ) *SAG 1 1 ) ) 

OEN=ICAPMI l) **2*CAPMI 2 ) **2*CAPMl 3 >**2/2 ,+CAPMl 4 )**2) /ONDC 

TEMPI!) = CAPMI lJ/DEN 

Rt 1 ,1 ) = ALF 1 1 ) +TEMP !1)*CAPM(1) 

R!2,l) = ALF!4)+TEMPI1)*CAPM12) 

RI 1, 2 ) = R I 2, 1 ) 

RI3.1) = TEMPI 1)*CAPM(3) 

R 1 1, 3 ) = R 1 3 , 1 ) 

TEMPI!) = CAPMI 2J/DEN 

RI 2, 2 ) = ALFI2WEMPU)*CAPMI2> 

R 1 3 , 2 ) = TEMPI1)*CAPMI3) 

R I 2, 3 ) = RI 3 , 2 ) 

RI 3, 3 ) = ALFI3)+CAPMI3)*CAPMI3)/DEN 
C SOLVE SYJTEM FOR STRESS INCREMENT 

CALL LINEQU I R, OTOT , 3, 1, 3, NERR ) 

IF INERR.EO.O) GO TO 260 
GO TO 990 

260 DSIGtl) = OTOT I 1 ) 

DSIGI2) = OTOT ( 2 ) 

DSIGI3) = OTOT ( 3 ) 

C PLASTIC STRAIN INCREMENTS 

TEMPI 1 ) = CAPMI 1)*0T0TI l ) +CAPM 1 2 ) *DTOTI 2 )*CAPMI 3 ) *DTOT 13) 

TEMPI 2 ) = TEMPI D/OEN 
00 2T0 1=1,3 

OEPS 1 1 ) = CAPMI I)*TEMPI2) 


3B00010 

3800020 

3800030 

3800040 

3B00050 

3800060 

3800070 

3800080 

3800090 

3800100 

3800110 

3800120 

3800130 

38001A0 

3800150 

3800160 

3800170 

3800180 

3800190 

3800200 

3800210 

3800220 

3800230 

3800240 

3800250 

3800260 

3800270 

3800280 

3800290 

3800300 

3800310 

3800320 

3800330 

3800340 

3800350 

3800360 

3800370 

3800390 

3800400 

3800410 

3800420 

3800430 

3800440 

3800450 

3800460 

3800470 

3800480 

3800490 

3800500 

3800510 

3800520 

3800530 

3800540 

3800550 

3800560 

3800570 

3800500 

3800590 

3800600 

3800610 
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SALPHUtLR) * SALPHt I,LR)+SAGm*TEHPtl>/2.0 3800620 

SIGMA! I t LR) = S IGMA! 1«LR )*DSI6( I ) 3800630 

270 SEPStl.LR) - SEPS! I »LR)+DEPS! I ) 3800640 

990 RETURN 3800650 

ENO 3800660 


187 



on on on on on oo non 


FOR, IS EPSIStEPSIS 

SUBROUTINE EPSIS I OTOT, OEPS , SI GM A ,DSIG , SEPS.LR ,NERR, 

1 GPLUH, FPLUH*HP* TWON) 

PERFECT PLASTICITY- SHELL ELEMENTS 

COMMON /CHAIN/ ZETA1 ( 21 1 , ZETA2( 21 ) , NODE, ALF l A ) ,CE I *1 ,NLRS,HI ,H0, T 
DIMENSION DTOTm,OEPSm,SIGMAI3,l»,OSIG(l»,SEPS(3, II ,EUP<3,3), 

0 SMAM(3) ,ESTAR( 3,3),CAPM<3! 

CAPM(l) = GPLUH*S I GMA( 1 , LR )-HP*S IGMA ( 2 , LR ) 

CAPMI2) = FPLUH*S IGMA( 2, LR )-HP*SIGHA ( 1 , LR ) 

CAPMI3) = THON*S IGMA ( 3, LR I 
TMAX = ABS ( CAPM( 1 ) ) 

MM AX* 1 

IF ( ABS (CAPM(2)).LT.TMAX) GO TO 110 
MMAX = 2 

TMAX= ABS ( C APM< 2 ) I 

110 I F ( ABS ( C APM( 3 ) I .LT. TMAX) GO TO 140 
MMAX = 3 

140 TEMP = CAPM(MMAX) 

INITIALIZE EUP.E UPPER BAR 
152 DO 170 I =1,3 
DO 160 J=l* 3 
160 EUP(I.J) =0.0 
170 EUP ( 1,1) = 1.0 

SET SHAM AND COMPLETE EUP 
DO 180 I = 1,3 
SMAMIU = CAPMIU / TEMP 
EUP(MMAX.I) = EUPIMMAX, I ) - SMAMII) 

180 CONTINUE 

EUP (MMAX, MMAX) = 0.0 

ESTAR=ALF * EUP 
DO 190 I =1,3 

ESTAR! 1,1) = ALF( 1)*EUP( 1,1 )+ALF 1 4 ) *EUP 1 2* I ) 

ESTAR( 2,1) = ALF(4)*EUPI1,I)+ALFI 2 )*EUP (2,1) 

190 ESTAR ( 3 , 1 ) = ALF < 3 ) *EUPI 3, I J 

ESTAR=ESTAR,+ E LOWER BAR 
DO 200 I =1,3 

200 ESTARl I, MMAX ) = EST AR( I , MMAX ) ♦ SMAMII) 

SOLVE LINEAR SYSTEM FOR DSIG( I.NE.MMAX) ANO OEPS(MMAX) 

CALL LINEQU( ESTAR, OTOT, 3, 1, 3.NERR) 

IF (NERR . EQ.O ) GO TO 210 
GO TO 990 
210 DO 220 I =1,3 
220 DSIG(I) = DTOT(I) 

SET OSIGIMMAX) ANO OEPS ( I .NE .MMAX ) 

DEPS(MMAX) = DSIG(MMAX) 

DSIG(MMAX) = 0.0 

00 230 I =1,3 

IF « I . EQ .MMAX I GO TO 230 

OSIGIMMAX) = DS IG (MMAX) - SMAMII) * DSIG(I) 

OEPS(I) = SMAM(I) * OEPS ( MMAX ) 

230 CONTINUE 

DO 290 I =1,3 

SIGMA! I , LR ) = SIGMA(I.LR) ♦ OS IGI I ) 

290 SEPS 1 1 , LR ) = SEPS(I.LR) «• DEPS(I) 
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c 


990 RETURN 
END 
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FOR, IS SMEAR, SMEAR 

SUBROUTINE SMEAR ( ES, NPLEVS.NPLA ST, STSI G , STALPH .RMOSNS .STREPS, 

1 RMOSSS,SIGOXS,STBAPH,EFFST,DENPHI»DEMPHI,SPH» 

2 CPH.OTOT, AST ) 

COMMON /PLSTIC/ 10, JO, IOR , JOR.KOR I 
COMMON /CDISP/ P,PMAX,DELP,0ELP1,YEPS,ZEPS 
DSIG = ES*OT OT 

IF (NPLEVS.EO.O) GO TO ICO 

IF (NPLAST. LE.O) GO TO 200 

IF ( (STS IG-STALPH)*DSIG.LT.ZEPS) GO TO 300 

IF (RMOSNS. NE. 0.0) GO TO 400 

DEPS = OSIG/ES 

STREPS = STREPS+DEPS 

OSIG = 0.0 

GO TO 600 

400 IF (RMOSSS.EQ.O.O) GO TO 500 

TOMP = .42857i43*RN0SNS*(ABS( STSI G- STBAPH ) /RMOSSS) ** (RMOSNS-l.O) 
OSIG = USIG-(l.O+TOMP) 

ROSIG = DSIG 

DEPS = TOMP/ES*OSIG 

STSI6 = STSIG+DSIG 

STREPS = STREPS+DEPS 

IF (KORI.EQ.O) RDSIG = 0.0 

STALPH = STALPH+ROS IG 

IF (KORI.EQ.O) EFFST * STSIG 

GO TO 600 

500 DSIGT = RMOSNS+OSIG 
RDSIG = DSIG 
STSIG = STSIG+DSIG 

DEPS =» DSIG/ES*(( 1. O-RMOSNS ) /RMOSNS ) 

STREPS = STREPS+OEPS 
IF (KORI.EQ.O) ROSIG * 0.0 
STALPH = STALPH+ROS IG 
IF (KORI.EQ.O) EFFST * STSIG 
GO TO 600 
300 NPLAST * -1 
200 STSIG = STSIG+OSIG 
DEPS = 0.0 
YCOND = YEPS 

IF (KORI.EQ.O) YCOND = YCOND*EFFST/SIGOXS 
IF ( ABS( ( STSIG-STALPH )/S IGOXS ) .GE .YCOND ) NPLAST * l 
600 CONTINUE 

DENPHI = ES*AST*DEPS/SPH 
DEMPHI = DENPHI*CPH 
GO TO 800 

100 STSIG = STSIG+OSIG 

IF ( ABS ( STS I G/S IGOXS) .LT.YEPS) GO TO 700 
NPLEVS = 1 
NPLAST = 1 
700 DENPHI = 0.0 
DEMPHI = 0.0 
800 RETURN 
END 
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FOR. IS SAVXES. SAVXES 

SUBROUTINE SAVXES ( SAVX ) 
INTEGER SAVJTC.SAVSTP.Q* THICK 
INTEGER XN 

DOUBLE PRECISION YPRED 
C 


COMMON STORY (16). XM AT (270. 10),STD( 10 ) , SADUS( 30) ,RA0US(30) 

COMMON T AOUS ( 30 ) .UADUS( 30 ) , SAVT IC ( 900) 

COMMON XN.TEFREE, TIC, PHI.STOP, RESTOP, RTICK.Gi. XNL ( 3) ,NH 
COMMON NST(30),NKL(30),NXMAT(20).SAVJTC(30),SAVSTP(30) ,JRTIC(30) 
COMMON JRSTQP( 30 ) , NREG. NMPT.NRC.NSC .NIX.IERRQR, KGE OM , I GEOM, I STT AB 
COMMON KELVIN, I BEGIN, NPROB,NSEG,NERROR,Q, THICK, NOJS.NL INKS, NLCASE 
COMMON NTSKL.NZ.NBCT.L INPUT, NTRKL .NPASS , XN1, KBC , NR INGS 
COMMON LOOE, ICYCLE.LOISTL 

COMMON /LASTEQ/ YPRED ( 8 ) , YOOT ( 8 ) , YA SAVE ( 8) , 

1 YANTH, YAMTH, Y AMPT , YANPT , YAOPH, YAQPH, YAQTH, YAJPH, 

2 S, SN, CS , SNSO, C SSO, TAN, SEC,CN,X1CS,X1 SN.TN, 

3 XIRO.XIROSO , XI SNRO, X1C SR0.CN1R0, SN1R 0, CS 1R0, 

A X1R1,X1R2,CS1R1,CS1R2,SNIR1,X1RISQ,R2SQ,R0,BESQ, 

5 ROSQ.XNSO, BET A, R1,R2, S1,R 1D0T , R ISO, 

6 XNTTH,XNTPH,XMTTH,XMTPH,XFTHLD, XFPHL D, XF 2ELD , 

7 XMTHLD, XMPHLD, ETHET,EPHI,XGPT,ALPHTH,ALPHPH, 

8 XNUTP,XNUPT,XC11,XC22,XC15,XD33,XD22 ,XD21,XD12, 

9 XK11,XK12,XK21 , XK22 , XK33.XD11, 

A M.I.SITIN.SI TOUT .SIPIN.SI POUT ,TPTIN,TPTOUT, 

B ZBR IN, ZBROUT »SCRIPA,SCRIPI»SIFIN,SlFOUT,TZEPH»TZETH 

B , XNPHI,BETTA,ZETTA,XC16 

C ,RMOSS,RMOSN,YLOST, ROC, HP, FPLUH ,GPLUH,TWON 

0 .RMOSSY ,RMOSNY,RMOSXY,RMONXY 

D , RMOSNS , RMOSSS, SIGOXS.RMOSNR .RMOSSR, SI GOXR 

COMMON /WOOD/ S AVY< 53 > , NPLEV ,NLPO,NPLA ( 21) , STR( 6 ) , SI GMA( 3,21 ) , 

C SEPS(3,211.SALPH(3,21),SBAPH(3,Zl),STEPS(3,21), 

0 EFF(21),STSRN(3),NPLAST(3),STSIG(3) .STREPS (3) , 

M STALPH(3),STBAPH(3),EFFST(3),NPLEVS(3) 

COMMON /COISP/ P,PMAX,DELP,0ELP1,YEPS,ZEPS 
EQUIVALENCE ( XNL ( 1 ) ,X 1 ) , ( XNL ( 2 ) , X2 ) , (XNL ( 3 J , X3 ) 

DIMENSION SAVX( 1) 

GO TO (101, 102, 103), I GEOM 
101 CONTINUE 

A = (SAVX(l)*CS-SAVX(3)*SN)/R0+0.5*SAVX(9)*SAVX(9)*(SAVX(2)- 

1 SAVX(3) )/Rl+0.5*SAVX(5)*SAVX(5) 

SAVX( 33 ) = -(SAVX(29)-Rl*(CS/R0*(-2.0*SAVX( 16)-SAVX( 21)*(l.0/Rl- 

1 SN/RO) )-Xl*( SAVXt 24)*A+SAVX(25)*SAVX(4) /Rl+SAVX ( 26 ) ♦ 

2 SAVX(9))-SN/R0*(SAVX(28)+X1*(SAVX(7)*SAVX (9)-SAVX(8>* 

3 SAVX(5)))-SAVX(24)») 

SAVX (34) * -(SAVX(30)-R1*(CS/R0*(-SAVX(6)+SAVX(7) ) +S AVX ( 17 ) /Rl- 
1 X1*(SAVX(25)*A-SAVX(26)*SAVXI5) )-SAVX(25) )> 

SAVX (35) « ~(SAVX(31)*R1*( ( SAVX( 17 )*CS+SAVX( T)*SN) /R0+SAVX(6)/R1+ 

1 X 1*( SAVX (26)*A-SAVX( 24)*SA VX ( 9)+ SA VX (25 )* SA VX (5 ) ) ♦ 

2 SAVX ( 26 ) ) ) 

SAVXI36) == SAVX(32)-R1*((CS/R0*(SAVX(20)-SAVX(18)))*SAVX(17)+ 

1 X1*(SAVX(8)*SAVX(9)-SAVX(6)*SAVX(5) )*SAVX (27) ) 


GO TO 105 
102 CONTINUE 

A ■ (SAVX(1)-SAVX(3)*TN)/S*0.5*(SAVX(9)*SAVX(9)+SAVX(5)* 

1 SAVX ( 5 ) ) ♦SAVX ( 2 ) 

SAVXI33) = -2.0*SAVX(16)/S«-SAVX(21>*TN/($*S)-X1*(SAVX(24)*A* 
1 SAVX(25)*SAVX(4)+SAVX(26)*SAVX(9) )-SAVX (2 8) 4TN/S- 

1 TN/S*Xi*(SAVX(7)* 

2 SAVX (9)-SAVX(8)*SAVX(5))-SAVX(29)-SAVX(24 ) 


3400010 

3400020 

3400030 

3400040 

3400050 

3400060 

3400070 

3400080 

3400090 

3400100 

3400110 

3400120 

3400130 

3400140 

3400150 

3400160 

3400170 

3400180 

3400190 

3400200 

3400210 

3400220 

3400230 

3400240 
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3400290 
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3400360 

3400370 
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3400390 

3400400 

3400410 
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SAVX( 34 ) 

1 

SAVX( 35 ) 

1 

SAVXI36) 

1 


— ( SAVX(6 I- SAVX ( 7 ) ) / S-Xl* ( SAVX (25 l*A-SAVX( 26 )*SAVX (5 ) ) - 
SAVX(30)-SAVX(25) 

~(SAVX( 17)*SAVX(7J*TN)/S-X1*( SAVX (26 )*A-SAVX( 24)* 

S AVX( 9 )*SAVX ( 25 ) *SA VX ( 5 ) >-SAVX(31 )-SAVX(26) 

-( (SAVX(20)-SAVX( 18 > )/S+SAVX( 17 ) +X l* ( SA VX ( 8 )* SA VX ( 9 >- 
S AVX ( 6 ) *S AVX (5) )+SAVX(27)-SAVX(32)) 


103 


GO TO 105 
CONTINUE 
A « -SAVXC 
S AVX ( 33 ) » 


105 


151 


SAVXI34) * 
SAVXI35) = 

l ■ 

S AVX ( 36 ) = 

t 

CONTINUE 
SAVXI37 ) = 
SAVXI38) = 
SAVXI39I = 
SAVXI40) » 
SAVXI41I = 
SAVXI42) = 
SAVXI43J = 
SAVXI44) = 
SAVX(45> = 
SAVXI46) = 
SAVXC47J = 
IF ( ISTTA8 
GO TO (151 
CONTINUE 
SAVX(48> = 


3 ) /R0*0.5*( SAVX ( 9)*SAVX(9)*SAVX(5)*SAVX(5) )*SAVX(2) 
-X1*(SAVX(24)*A«-SAVX(25)*SAVX(4)+SAVX(26)*SAVX(9) J- 
SAVX(28)/R0-X1*(SAVX(7)*SAVX(9)-SAVX(8)*SAVX(5) >/R0- 
S AVX (29)-SAVX(24) 

-Xl*( SAVX ( 251 *A-SAVX( 26 1* SAVX ( 5 ) )-SAVX( 30 I-SAVXI25) 
-SAVX (7 ) /RO-X 1*( SAVX(26)*A-SAVX(24)*SAVX( 9)+SAVX(25)* 
SAVX(5))-SAVX(31)-SAVX(26) 

-( SAVX! 17)*X1*(SAVX(8)*SAVX(9)-SAVX(6>*SAVX(5) )♦ 
SAVX127) )*SAVX(32) 

SAW (371 +SAVX ( 10) 

SAVY ( 38 ) +SAVX (11) 

SAVY(39)*SAVX(12I 
SAVY ( 40 ) *S AVX ( 13) 

SAVY ( 41 )*SAVX ( 14) 

SAVY (42)*SAVX(15) 

S AVY (43)*DELP*XNTPH 
SAVY(44)*DELP*XNTTH 
SAVY (45)*DELP*XMTPH 
SAVY(46)*0ELP*XMTTH 
SAVY (47)-»YD0T(I+7) 

.NE.2) GO TO 7776 
« 152> 153 ) • IGEOM 


SAVX(7)-(XNUPT*SAVX(6)*(XK11-XNUPT**2*XK22)*( (SAVX(l)* 
CS-S AVX ( 3 ) *SN ) *X1R0+X 1*SAVX( 9)**2*0.5)+XNUPT* SAVXI43I- 
S AVX ( 44 ) +X2*( XNUPT*SAVX'( 38)-SAVX(37) I) 

SAVX ( 49) = SAVX(20)-(XNUPT*SAVX(18)-(XD11-XNUPT**2*XD22>*X1R0* 

SAVX(5)*CS*(XNUPT*SAVX(45)-SAVX(46) )*X2*( XNUPT*SA VX( 41 ) 
-SAVX ( 40 ) ) ) 

SAVX( 50) = SAVX(21)-( (-1 .0/1 (R0/XD33 )♦ ( SNSQ*X1R0/XK3 31 >)*( SAVX (191 
*(CSIR1-CN1R0)*SAVX(16)*SN/XK33+X2*(SAVX( 39>*SN/XK33- 
SAVX(42)*R0/XD33)*SN*X1*SAVX(9)*SAVX(5) )) 

SAVX( 51 ) « S AVX ( 4 ) — ( R l*( SAVX ( 19 ) *C S1R0+ SAVX ( 16 ) /XK33*X2*SAVX (39 ) / 

L XK33*SAVX(21)*SN1R0/XK33)-*R1*X1*SAVX(9)*SAVX(5>) 

SAVX (52) = SAVX(2)-(Rl*(SAVX(3)*XlRl+( 1 . 0/ t XK22-XNUTP**2*XK1 1 ) )* 

( SAVX ( 6 )-XNUTP*SAVX ( 7 ) +SAVX{ 43 )-XNUTP*SAV X(44 ) + X2* 
(SAVX(38)-XNUTP*SAVX(37) ) ) )-Rl*SAVX ( 5 >**2 *X 1*0.5 ) 

SAVX ( 53 ) * SAVX(47)-(R1*(1.0/(XD22-XNUTP**2*XD11>)*(-SAVX(18)+ 
XNUTP*SAVX(20)-SAVX(45 ) ♦XNUTP*SAVX(46 ) -X2 *( SA VX (41 )- 
XNUTP*SAVX(40 ) ) ) » 


GO TO 175 
152 CONTINUE 
SAVX (48 ) = 

1 

2 

SAVX ( 49 ) = 

1 

2 

SAVX ( 50 ) = 

1 

2 

SAVXI51) = 


SAVX(7)-(XNUPT*SAVX(6)+(XK11-XNUPT**2*XK22>*( (X1CS/S)* 
( SAVX( 1 ) *CS-SAVX( 3 ) *SN ) +X1*SAVX( 9 ) ♦*2*0.5 J+XNUPT* 
■SAVX(43)-SAVX(44)*X2*( XNUPT*SAVX ( 38 J-SAVX (37) )) 
SAVX(20)-(XNUPT*SAVX( 18 )- ( 1 .0/S >*X1CS*( XD 11-XNUPT**2* 
XD22 ) *SAVX ( 5 ) *CS-SAVX( 46 ) +XNUPT*SAVX ( 45)* X2*( XNUPT* 

S AV X ( 4 1 ) — SAVX(40) ) ) 

SAVX (21)-((-i.0/((S*CS/XD33)+(SN*TN/(XK33*S)) ))*(- 
SAVX (19)*SN/S*SAVX( 16)*SN/XK33+X2*(SAVX(39)*SN/XK33- 
SAVX(42)*S*CS/X033)*SN*X1*SAVX(9)*SAVX(5) )) 

SAVX (4 )— ( ( 1.0/S ) *( SAVX( 19 ) + SAVX(2l )*TN/XK 33 )*SAVX (16 ) / 
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1 XK33+X2*SAVX(39)/X*C33+X1*SAVX(9)*SAVX(5>) 

S AVXt 52 ) = SAVX(2)-((1.0/(XK22-XNUTP**2*XKll))*(SAVXt 6 )- XNUTP* 

1 SAVXt 7 )*SAVX( 43 )-XNUTP*SAVX(44)+X2*( SAVXt 38)-XNUTP* 

2 SAVX ( 37 ) ) )-X 1*SAVX( 5 ) *SA VXt 5 ) *0. 5 ) 

SAVXt 53) = SAVXt 47 )-( ( 1 . 0/ t XD22-XNUTP**2*XD1 1 ) >* t-SA VX t 1 81+XNUTP* 

1 S AVX ( 20 ) -SAVX ( 45 ) ♦XNUTP*$AVX ( 46>-X2* ( SAVX (4 1 ) -XNUTP* 

2 SAVX ( 40 ) 1 ) 1 


GO TO 175 
153 CONTINUE 
SAVX ( 48 ) * 

1 

2 

SAVXI49) = 

1 

SA V* ( 50 I * 

1 

2 

SAVXI51) = 


1 

SAVX! 52 ) * 


1 

2 

S AVXt 53 ) * 


1 

2 


SAVX(7)-(XNUPT*SAVX(6)+(XK11-XNUPT**2*XK22)*(-X1R0* 
SAVX(3)+X1*SAVX(9)**2*0.5)+XNUPT*SAVX(43) -SAVXt 44)* 

X2*t XNUPT*SAVX t 38 ) -SAVX t 3? ) ) ) 

S AVX t 20 ) - 1 XNUPT *S AVXt 18 ) + t XNUPT*SAVX 1 45 )- SA VX «46 ) )♦ 

X2*( XNUP T*SAVXt 41 1- SAVXt 40 ) 1 I 

SAVX (21 )-( <-1.0/( (R0/XD33) + (X1R0/XK33) ) )*( SAVXt 16 )/XK33 
♦X2*t SAVXt 39)/XK33-SAVXt 42 1 *R0/XD33 ) +X1*S AVX 1 9) *SAVX( 5) 
» > 

SAVX(4)-(SAVX( 16)/XK33+X2*SAVX(39)/XK33+SAVX(21>*XlRO/ 
XK33+Xl*SAVX(9)*SAVXt5) ) 

SAVX ( 2 )- ( ( 1.0/t XK22-XNUTP**2*XK1 1 ) ) * ( SAVX t6)-XNUTP* 
SAVX(7)+ISAVX(43)-XNUTP*SAVX(44) >+X2*( SAVXt 38 )-XNUTP* 
SAVXt 371 ) )-Xl*SAVXt 5)*SAVXt 5 )*0. 5) 

SAVXt 47 1-t 1 1.0/(XD22-XNUTP**2*XD11> ) * t-SA VX 1 18 KXNUTP* 

S AVX ( 20 ) -*•( XNUTP*SA VXt 46 ) -SAVX (45 ) )-X2* t SA VX (41 l-XNUTP* 
SAVX ( 40 ) » ) ) 


GO TO 175 
7776 IF (ISTTA0 
GO TO ( 161 
161 CONTINUE 
SAVX ( 48 ) = 


. GE.3 . AND. ISTTA8.LE.9) GO TO 7777 
,162.163), 1GE0H 


SAVXt7)-(XKl2*(1.0/<XK22*XC22**2/XD22)>*( SAVX(6)+ 

1 SAVX (43)*X2*SAVX(38 )♦ XC22/X022* (SAVX(18)+SAVX(45)*X2* 

2 S AVX ( 41 ) ) l-SAVX t 44 )-X2*SAVXt 37) ♦( X1R0*XK1 1-XK12*XK21* 

3 X1R0*( 1.0/(XK22*XC22**2/X022) > )* ( SAVX ( 5 )*CS-S AVX ( 3 ) *SN+ 

4 X1*RO*SAVX(9)**2*0.5>-(XC11+XK12*XC22*XD21/XD22*( 1.0/ 

5 ( XK22+XC22**2/X022 ) ) J*SAVX( 5 )*CS*X1R0 ) 

SAVX ( 49 ) = S AVX ( 20 ) - ( -XD12* t XC22/ ( XC22**2+XK22*XD22) )*15AVX(6)+ 

1 SAVX(43)+X2*SAVX(38I )-SAVX( 46 )-X2*SA VXt 40 )+ XD 12* ( XK22/ 

2 (XC22**2+XK22*X022) )*( SAVXt l 8 >+SA VXt 45 ) +X2*SA VX 141 ))♦ 

3 (XCll*XlR0+X012*XK2i*XlR0*(XC22/(XC22**2+XK22*XD22m* 

4 (SAVX(1)*CS-SAVX(3 )*SN+X 1*R0*SAVX (.9 ) **2*0 • 5 )■* ( XD1 1- 

5 X012*XK22*X021/(XC22**2+XK22*XD22))*SAVX( 5)*CS*X1R0) 
SAVXt 50) = SAVXt 21)- 1 t -1.0/t lR0/XD33)*t SNSQ*X1R0/XK33) ))*lSAVXt 19) 

1 *(CSIR1-CN1R0)*SAVX( 16 >*SN/XK33+X2* ( S AVXt 39 )*SN/XK33- 

2 SAVXt 42 1 *RQ/X033 )+SN*Xl*SAVXl9)*SAVX(5) )) 

SAVXt 51 ) = SAVX14)— (R1*($AVX( 1 9 )*CS1R0+ SA VX ( 16 ) /XK33*X2*SA VX (39) / 

1 XK33>SAVX(21)*SN1R0/XK33)+R1*XI*SAVX(9)*SAVX(5) ) 

SAVX (52) = SAVX(2)-(Rl*tSAVX(3 )*X IR 1-X1*SAVX ( 5 ) **2*0 . 5 + ( 1.0/(XK22 

1 +XC22**2/X022) )*( SAVXt 6 » + SA VXt 43 ) +X2* SA VX (38) ♦ ( XC 22/ 

2 XD22)*t SAVXt 1 8 )+SAVX t 45 ) >X2* SAVX ( 41 ) >-XK21*XlR0* 

3 (SAVXt U*CS-S AVXt 3 )*SN)-X1*XK12*S AVXt 9) **2*0.5- (XC22* 

4 XD21/X022)*SAVX(5 )*CS*X 1R0 I ) » 

SAVX (53) = SAVXt 47 )-(Rl*((-XC22/( XC22**2+XK22*XD22 ))*(SAVX16)* 

1 SAVX(43)*X2*SAVX(38)-( XK21/R0 )* ( S AVX ( 1 > *C S-SAVX ( 3 )*SN )- 

2 Xl*XK12*SAVX(9)**2*0.5)+tXK22/(XC22**2+XK22*XD22) )* 

3 (SAVX(18)*SAVX«45)*X2*SAVX(41))-(XK22*XD21/(XC22**2* 

4 XK22*X022) )*SAVX(5)*CS*X1R0) ) 


GO TO 175 
162 CONTINUE 

SAVXt 48 ) = SAVX(7)-(XK12*(1.0/(XK22*XC22**2/X022))*(SAVX(6)+ 

1 SAVX(43)+X2*SAVX(38)+(XC22/XD22)*( SAVXt 18 )+ SAVX «45)+ 

2 X2*SAVX( 41 ) ) )-SAVX(44)-X2*SAVX(37) + (1.0/tCS*S))*.(XKll- 


3401210 

3401220 

3401230 

3401240 

3401250 

3401260 

3401270 

3401280 

3401290 

3401300 

3401310 

3401320 

3401330 

3401340 

3401350 

3401360 

3401370 

3401380 

3401390 

3401400 

3401410 

3401420 

3401430 

3401440 

3401450 

3401460 

3401470 

3401480 

3401490 

3401500 

3401510 

3401520 

3401530 

3401540 

3401550 

3401560 

3401570 

3401580 

3401590 

3401600 

3401610 

3401620 

3401630 

3401640 

3401650 

3401660 

3401670 

3401680 

3401690 

3401700 

3401710 

3401720 

3401730 

3401740 

3401750 

3401760 

3401770 

3401780. 

3401790 

3401800 

3401810 
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3 

4 

5 

SA VX (49 ) 

1 

2 

3 

4 

5 

SA VX ( 50 ) 

1 

1 

SAVX (51 ) 

1 

SAVX ( 52 ) 

1 

2 

3 

4 

SAVXl 53 ) 

1 

2 

3 

4 


XK12*XK21*( 1.0/(XK22+XC22**2/X022) ) )*(SAVXli)*CS- 
SAVX(3)*SN+X1*S*CS*SAVX(9)**2*0.5)-(XC11+(XK12*XD21* 
XC22/XD22)*( 1.0/(XK22+XC22**2/XD22) ) )*SAVX15)/S) 

SAVXl 20 )-(-X012*(XC22/(XC22**2+XK22*X022) >*ISAVX(6)+ 
SAVX143)+X2*SAVX(38))-SAVX146)-X2*SAVX140)+XD12*(XK22/ 
(XC22**2+XK22*X022) )*(SAVX(18)+SAVX(45)+X2*SAVX(41) ) + 
(XC11/(S*CS)+XD12*XK21/IS*CS ) )* t XC22 / l XC2 2**2+XK22* 
XD22 ) ) *( SAVXl 1)*CS-SAVX(3 )* SN+X1*S*C S*S AVX ( 9) **2*0.5 ) 
+(XD11-XD12*XK22*X021/IXC22**2+XK22*XD22) )*SAVX(5)/S) 
SAVXl 21 )-( 1-1. 0/1 ( S*CS/XD33)+ISN*TN/IXK33*S) ) >)*(- 
SAVXl 19) *SN/S+SAVX( 16)*SN/XK33+X2*ISAVX(39)*SN/XK33- 
SAVX(42)*S*CS/X033)+SN*Xi*SAVX(9)*SAVX(5) )) 

SAVX ( 4 )- ( ( 1.0/S )*< SAVXl 19 >+SAVX ( 2 1 >*TN/XK 33 )♦ SAVXl 16 ) / 
XK33+X2*SAVXl 39 ) /XK33+X1*SA VX (9) *SAVX (5 > > 
SAVX(2)-(-Xl*SAVX(5)**2*0.5+ tl.0/(XK22+XC22**2/XD22))* 

( SAVXl 6 )+SAVX( 43 ) +X2*SAVXl 38 )+( XC 22/XD22) *( SAVX (18)+ 
SAVX(45)+X2*SAVX(41) )- ( XK21 / ( S*CS > >* ( SA VX ( 1 )*CS-SAVX l 3) 
*SN)-X1*XK12*SAVX(9)**2*0.5-(XC22*XD21/XD22)*SAVX(5>/ 
S)1 

SAVXl47)-(-(XC22/lXC22**2+XK22*XD22) )* ( SA VX (6 )+SAVX (43) 
+X2*SAVX(38)-XK21*ISAVX(1)*CS-SAVX(3)*SN) /IS*CS)-X1* 
XK12*SAVX19)**2*0.5) + (XK22/(XC22**2+XK22*XD22> >* 

(SAVXl 18 l+SAVX(45)+X2*SAVX(41) >- l XK22*XD2 1/ ( XC22**2+ 
XK22*XD22) )*SAVX(5)/S) 


GO TO 175 
163 CONTINUE 
SAVXl 48) = 

1 

2 

3 

4 

SAVX 1 49 ) =■ 

1 

2 

3 

4 

SAVXl 50 ) =■ 

1 

2 

SAVXl 51) = 

1 

SAVX (52) = 

1 

2 

3 

SAVX (53) = 

1 

2 

3 


SAVX(7)-(XK12*( l.0/(XK22+XC22**2/XD22) )*( SAVX l 6 )♦ 
SAVX(43)+X2*SAVX(38)+lXC22/XD22)*l'SAVX(18) + SAVX(45> + X2* 
SAVX (41) ) )-SAVX( 44 )-X2* SAVXl 371* l X1R0*1 XK11— XK12*XK21* 

( 1 .0/ ( XK22+XC22**2/XD22 ) ) > ) * l-SAVX (3 ) +X1*R0*S AVX ( 9) * 
SAVX ( 9 ) *0.5 ) ) 

SAVX (20)-(-XD12*(XC22/l XC22**2+XK22*XD22) )*(SAVX(6)+ 
SAVX143)+X2*SAVX(38)>-SAVX(46>-X2*SAVX(40 )+XD 12* l XK22/ 
IXC22**2+XK22*X022) )*l SAVXl 18 l+SAVX ( 45 ) +X2*SAVX l 41 ) ) + 

( XC 1 1*X1RO+X012*XK2 1*X 1R0*( XC22/ l XC22**2+XK22*XD22 ) ) )* 
l-SAVX(3)+Xl*R0*SAVX(9)*SAVX(9)*0.5) ) 

SAVXl 21 )-((-!. 0/1 (R0/X033I+ l XIR0/XK33) ) )* l SAVXl 16 ) /XK33 
+X2*(SAVX(39) /XK33-SAVXI 42) *R0/XD33 )+Xl*SAVX(9)*SAVXl5) 
> ) 

SAVX (4)- l SAVXl 16)/XK33+X2*SAVX139) /XK33+S AVXl 21 ) *X1 RO/ 
XK33+X1*SAVX(9)*SAVX15> ) 

SAVX(2)-(-Xi*SAVXl5)**2*0.5+( 1.0/1 XK22+XC 22**2/XD22 > )* 
(SAVX(6)+SAVX143)+X2*SAVX(38)+(XC22/XD22) *( SAVX (18)+ 
SAVX(45)+X2*SAVX(41) )-( XK21*X 1R0 ) * l-SAVXl 3) )-Xl*XKl2* 
SAVX(9)*SAVX(9)*0.5)) 

SAVXl 47 )-(-(XC22/(XC22**2+XK22*XD22> )* ( SA VX (6 J+SAVX143) 
+X2*SAVX(38I-XK21*XIR0*(-SAVX(3) )-Xl*XK12 *SAVX l 9) * 
SAVX(9)*0.5)+(XK22/IXC22**2+XK22*XD22) >*( SAVX (18)+ 
SAVX(45)+X2*SAVX141) ) ) 


GO TO 175 
777*7 GO TO (171 . 172* 173) » IGEOM 
171 CONTINUE 

SAVXl 48 ) = SAVX(7)-((SAVX(6)+SAVX(43)+X2*SAVX138))*IXC15*XC22+XD22 

1 *XK12)/IXK22*X022+XC22**2 (-SAVX ( 44 )-X2*SA VX ( 37) ♦ ( XK12* 

2 XC22-XK22*XC 1 5 )*( S AVX l 18 )+SA VXl 45 ) +X2*SAVX(4l ) ) / ( XC22 

3 *XC22+XK22*X022)+(X1RO*(SAVX(1)*CS-SAVX(3 )*SN)+X1* 

4 SAVX(9)**2*0.5)*(XKll+(XC15*(XC15*XK22-2. 0*XK12*XC22 ) - 

5 XK12*XK1 2*X022 )/(XK22*XD22+XC22*XC22)) + XlR0*SAVX(5)*CS* 

6 1-XC11+(XC15*XC15*XC22+XC15*(XK12*XD22+XK22*XD12)-XK12 

7 *X0l2*XC22)/( XK22*XD22+XC22*XC22 ) ) ) 

SAVX149) = SAVX120I-1 (SAVXl 18 I +SAVX ( 45 ) +X2*SAVX (41 ) ) *( XC15*XC22+ 


3401820 

3401830 

3401840 

3401850 

3401860 

3401870 

3401880 

3401890 

3401900 

3401910 

3401920 

3401930 

3401940 

3401950 

3401960 

3401970 

3401980 

3401990 

3402000 

3402010 

3402020 

3402030 

3402040 

3402050 

3402060 

3402070 

3402080 

3402090 

3402100 

3402110 

3402120 

3402130 

3402140 

3402150 

3402160 

3402170 

3402180 

3402190 

3402200 

3402210 

3402220 

3402230 

3402240 

3402250 

3402260 

3402270 

3402280 

3402290 

3402300 

3402310 

3402320 

3402330 

3402340 

3402350 

3402360 

3402370 

3402380 

3402390 

3402400 

3402410 

3402420 
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L 

2 

3 

4 

5 

6 
7 

SAVXt 50 ) = 

1 

2 

3 

S AVX ( 51) = 

1 

2 

SAVXt 52 ) = 

1 

2 

3 

4 

SA VX ( 53 I = 

1 

2 

3 

4 

GO TO 175 

172 CONTINUE 
SAVX(48 ) * 

1 

2 

3 

4 

5 

6 
7 

SAVX ( 49 ) = 

1 

2 

3 

4 

5 

6 
7 

SAVXI50) = 

1 

2 

3 

SAVX (51) = 

1 

2 

SAVXt 52 ) = 

1 

2 

3 

4 

SAVXJ53) = 

1 

2 

3 

4 

GO TO 175 

173 CONTINUE 


XK22*X01 2 )/ (XK22*XD22+XC22*XC22)+(SAVX(6)+SAVXt43)+X2* 
SAVX (381 )*( X022*XC 15-X012*XC22 ) / t XD22*XK2 2+XC22*XC22 ) - 
SAVXt 46 )-X2*SAVX ( 40 )+XlRO*SAVX ( 5 ) *CS* tXOl 1- tXD12*XD12* 
XK22+XC1 5*( 2 .0*XC22*X0 12-XC 1 5*XD22 ) ) / ( XC2 2*XC22*XK22* 
XD22) )*tXlRO*(SAVX( 1>*CS-SAVX(3)*SN)+X1*SAVX19)* 

SAVXt 9)*0.5)*(XC11*( XD 12*XC22*XK1 2-XC15*l XC15*XC22* 
XD12*XK22+X022*XK12))/t XC22*XC22+XK22*XD2 2) ) l 
SAVXt 21 )-( t 1.0/(XC16*SN*XiRO-XK33-SN*XlRO*(XD33*SN/RO- 
XClfc) ) >*((XK33*XD33-XC16*XC16)*XlR0*SAVXt 19»*(CS« , X1R1- 
CN1R0)+XI*SN*SAVX(9)*SAVX(5) ♦(SAVXt 16 >*X2 *$ AVX ( 39 ) ) * 

( XD33*SN*X 1R0-XC 16 ) +X2*SAVX ( 42 )* t XK33-XC1 6*SN/R0> ) ) 
SAVXt 4 )-( R l*( SAVX(19)*CS*X1R0+X1*SAVX(9)*SAVX(5)+(1.0/ 

( XK33-XC 16*XC 16/XD33 ) )*(SAVX(16)+SAVX(2i) *t SN*XIR0-XC16 
/XD33 )-*-X2*(SAVX(39)-XC16*SAVX(42)/XD33))) ) 

SAVX (2)-(SAVX(3)-Rl*Xl*SAVX(5)*SAVXt5)*0. 5+Rl*(XD22* 
(SAVX(6»*SAVX(43)4X2*SAVX(38) )+XC 22* { SA VX ( 18 ) +SAVX t 45 >♦ 
X2*SAVX(41))-(X IR0*( SAVXt U*C S- SA VX t 3 1* SN )♦ X1*SAVX(9) * 
SAVX (9)*0.5)*(XK12*X022*XC15*XC22)-X1RQ*SAVX(5)*CS* 
(XC22*X012-XC15*X022) l/(XK22*XD22+XC22*XC22 >) 

S AVX ( 47 >-(Rl*(XK22*( SAVXt 18 J+SAVXt 45 H-X2* SAVX (41 ) J-XC22 
*(SAVX<6)+SAVX(43) + X2*SAVX(38))-MXlR0*(SAVXtl )*CS- 
SAVX(3J*SN> + X1«'SAVX(9)**2*0.5)*(XK12*XC22-XK22*XC15)- 
XlR0*SAVXt5)*CS*tXC15*XC22+XK22*XD12) )/(XC22**2*XK22* 
X022) ) 


SAVX(71-( tSAVX(6)*SAVX(43>+X2*SAVX(38) >*( XC 15*XC22+XD22 
*Xta2)/(XK22*XD22+XC22**2>-SAVXt44)-X2*SAVX(37)*(XKi2* 
XC22-XK22*XC15)*(SAVX(18)*SAVX(45)+X2*SAVX(41 ) )/(XC22* 
XC22+XK22*XD22 )♦(( SAVX t l)*CS- SAVXt 3 )*SN >/ t S*CS WX1* 
SAVX(9)**2*0.5I*(XK11+(XC15*(XC15*XK22-2.0*XK12*XC22)- 
XK12*XK12*X022)/(XK22*XD22*XC22*XC22))+SAVX(5) /S* t-XCll 
+(XC15*XC15*XC22+XC15*(XK12*X022+XK22*XD12>-XK12*XD12* 
XC22t/(XKZ2*X0224XC22*XC22H » 

SAVXt 20)- 1 (SAVXt 18 )«-SAVX(45J +X2*SAVX (41)1 *(XC15*XC22* 
XK22'*X012 ) / ( XK22*X022+XC22*XC22 )+tSAVX(6)+ SAVXt 43 )+X2* 
SAVXt 38) )*(XD22*XC15-X012*XC22)/(XD22*XK22+XC22*XC22)- 
SAVX ( 46 )-X2*SAVX ( 40 )*SAVX 1 5 ) /S* ( XDli- ( XD1 2*XD 12*XK22+ 
XC15*(2.0*XC224X012-XC15*X022))/(XC22«'XC22+XK22*XD22) )♦ 
( 1.0/(S*CS>*( SAVXt 1)*CS-SAVX(3)*SN)+X1*SAVX19>**2*0.5> 
*(XC11+(X012*XC22*XK12-XC15*(XC15*XC22*XD12*XK22+XD22* 
XK12) )/(XC22*XC22*XK22*XD22) ) ) 

SAVXt 21 )-( 1.0/(XC16*TN/S-XK33-(TN/S)*( XD33*TN/S-XC16) )* 
t (XK33*XD33-XC16*XC16)*(1.0/<S*CS) ) * t-SAVXt 19 > *SN/S )♦ 
Xl*SN*SAVX(9)*SAVXt 5IMSAVX( 16>+X2*SAVXI3 9) )*(XD33*TN/S 
-XC16)+X2*SAVX(42)*(XX33-XC16*TN/S) 1 ) 

SAVX (4)-( SAVXt 19J/S+X1*SAVX(9)*SAVX(5)+(1 .0/( XK33-XC16* 
XC16/X033) )4( SAVXt 16 ) +SAVX( 2 1 ) *( TN/S-XC 16 /X033 ) +X2* 

( SAVX t 39 )-XC164SAVX( 42 ) /X033 ) ) ) 

SAVXt2)-t-X14SAVX(5)**240.5+(X0224(SAVXt6 )+SAVX(43)+ 
X2*SAVXt 38 ) ) + XC22*t SAVXt 18) + SAVX1 45 ) + X2*S AVXt 41 ) )-( XK12 
4X0224XC15*XC22)*( t 1.0/ ( S*CS )*t SAVXt 1 >4CS-SAVX(3) *SN) )+ 
X 14$AVX( 9) 4*240. 5)- (XC 224X01 2-XC1 54X022)4 SAVX (5 )/S»/ 
tXK22*X022+XC224XC22) ) 

SAVX(47)-((XK22*(SAVX( 18 ) + SA VXt 45 > +X24SAV X 1 41 ) )-XC224 
(SAVX(6)+SAVXt43)*X2*SAVX(38) )+(XK12*XC22^XK224XC15)4 
( (1.0/(S4CS)4(SAVX(1)4CS-SAVX(3)4SN> )-*-Xl*SAVX (9 )A 
SAVXt9)*0.5)-(XC15*XC224XX22*XD12)4SAVX(5)/SI/(XK224 
X022+XC224XC22) ) 


3402430 

3402440 

3402450 

3402460 

3402470 

3402480 

3402490 

3402500 

3402510 

3402520 

3402530 

3402540 

3402550 

3402560 

3402570 

3402580 

3402590 

3402600 

3402610 

3402620 

3402630 

3402640 

3402650 

3402660 

3402670 

3402680 

3402690 

3402700 

3402710 

3402720 

3402730 

3402740 

3402750 

3402760 

3402770 

3402780 

3402790 

3402800 

3402810 

3402820 

3402830 

3402840 

3402850 

3402860 

3402870 

3402880 

3402890 

3402900 

3402910 

3402920 

3402930 

3402940 

3402950 

3402960 

3402970 

3402980 

3402990 

3403000 

3403010 

3403020 

3403030 
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wwh n h N) h- ^ w n h vn ^ rv *** 


SAVXJ48) 


SAVXI49) 


SAVXI50) 


SAVX ( 51 ) 


SAVX ( 52 ) 


SAVXI53) 


175 CONTINUE 
RETURN 
END 


SAVXm-< <SAVX(61 + SAVX(43)*X2*SAVX(38H*( XC 15*XC22*XD22 
*XK12)/(XK22*XD22+XC22*XC22 )- SAVX 144 1-X2* SAVX (37)-MXK12 
*XC22-XK22*XC15)*( SAVX t ( 18 l + SAVX ( 45 M-X2*SA VX 141 1 1/ CXC22* 
XC22*XK22*XD22 1 +1 X1R0*(-SAVX(3) )+Xl*SAVXC 91**2*0.51* 
<XKll+<XC15*(XC15.*XK22-2.0*XK12*XC221-XK12*XK12*XD22l/ 

( XK22*XD22*XC 22*XC22 1 1 ) 

SAVX(20)-( (SAVX( 18 1 +SAVX ( 45 1 +X2*S AVX ( 41 )) *( XC15*XC22+ 
XK22*XD12)/(XK22*XD22+XC22*XC22)+(SAVX<6) +SAVXI43 >4X2* 
SAVX (38) 1*1 X022*XC 1 5-XD1 2*XC22 1 / (-XD22*XK2 2+XC22*XC22 ) - 
SAVXC 46 )-X2*SAVX (40)*IX1R0* { -SAVX (3 ) )*Xi* SAVX (9 1* 

S AVX(9 1*0.5 »*<XCll-MXD12*XC22*XK12-XC15*l XC15*XC22* 
XD12*XK22+XD22*XK12 1 1 / { XC22*XC22+XK22*XD2 21)1 
SAVX( 21 )-( ( 1.0/(XC16*X1RO-XK33-X1RO*IXD33*X1RO-XC161 1 1* 
(X1*SAVX(91*SAVX(51*(SAVX(161*X2*SAVX(39) )*(XD33*X1R0- 
XC16)+X2*SAVXI15)*<XK 33-XCL6/R0 1 ) 1 

SAVX(41-(X1*SAVX(91*SAVXI51*( 1.0/1XK33-XC 16*XC16/X033 1 1 
*<SAVX<161+SAVX<21)*<X1R0-XC16/XD331*X2*I SAVX 139 1 -XC 16* 
SAVXI421/XD331 1 1 

SAVX (21-1 -X1*SAVX(51**2*0.5-MXD22*( SAVX 16 1*SA VX(43)*X2 
*SAVX ( 381 1+XC 22*1 SAVX (18 l+SAVXI 45 1+X2*SAVXI 41 11— IX1RO* 
(-SAVX<31 1*X1*SAVX(9)**2*0.5)*<XK12*XD22*XC15*XC221 1/ 
<XK22*XD22+XC22*XC22i 1 

SAVX(471-((XK22*(SAVX(18)+SAVX(451*X2*SAVX(41 1 1-XC22* 
(SAVX(61+SAVX(431+X2*SAVX(381 !♦( X1RO* (-SA VX (31 KX1* 

SAVX ( 9 1**2* 0. 5 )*( XK12*XC22- XK22*XC15 1 ) / (XC22*XC22+XK22 
*XD22 I ) 
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3403050 
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3403070 

3403080 

3403090 
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3403220 
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FOR. IS ARRAYS, ARRAYS 

SUBROUTINE ARRAYS < A, 8, C,D, E, F,G, H,0,PHI > 

COMMON /GRAF IX/ XI 100 ) , Y < 100, 9 ) ,NGR APH ,LDEF C 9 > ,NGR ,JCYCSNFLAG, JAM, 
C JNSC 

DIMENSION Z ( 9 ) 

ZIl) = A 
Z ( 2) = B 

zm = c 

Z(4> = 0 
Z ( 5 ) = E 
Z ( 6) = F 
Z ( 7) = G 
Z ( 8) = H 
Z19) = 0 
INOEX = 0 
JCYC « JCYC+1 
DO 100 J = 1 , 9 

IF ILOEFI JI.EQ.OI GO TO 100 
INOEX » INOEX+1 
YI JCYC, INOEX) = Z(J) 

100 CONTINUE 

X ( JCYC ) = PHI 

RETURN 

END 


4200010 

4200020 

4200030 

4200040 

4200050 

4200060 

4200070 

4200080 

4200090 

4200100 

4200110 

4200120 

4200130 

4200140 

4200150 

4200160 

4200170 

4200180 

4200190 

4200200 

4200210 

4200220 

4200230 
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SUBROUTINE ETRAP 


This is an error trap subroutine which can be called by the MAIN routine 
at various stages of program execution. If the indicator NIX is not equal 
to zero, MAIN will call ETRAP and indicate the proper error message to be 
printed . 
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FOR, IS ETRAP, ETRAP 

SUBROUTINE ETRAP 

INTEGER SAVJTC,SAVSTP,Q»THICK 

INTEGER XN 

COMMON ST0RY(16),XMAT!270,I0),STD( 10), SADUS! 30) ,RADUS(30) 

COMMON T ADUS < 30 ) ,UA0US( 30 ) , SAVT IC ( 900 ) 

COMMON XN.TEFREE, TIC, PHI, STOP, RESTOP, RT ICK ,G1 , XNLI 3) ,NH 

COMMON NSTI30),NKL(30)»NXMAT!20) , SAVJTC C 30) , SAVSTP (30) ,JRTIC(30) 

COMMON JRSTOP(30),NREG,NHPT,NRC,NSC,NIX, IERROR , KGEOM , IGEOM ,1 STTAB 

COMMON KELVIN, I BEGIN, NPROB.NSEG, NERROR ,0 , THICK, NOJS.NL INKS, NLCASE 

COMMON NTSKL,NZ,NBCT,LINPUT,NTRKL,NPASS,XN1,KBC,NRINGS 

COMMON LODE, ICYCLE.LD ISTL 

HR ITE( 6, 1726 ) 

1726 FORMAT ( 1 H X } 

GO TO (8000,8036,8086,8087,8069,8090,8013,8009,8031,8008,8001, 

1 8002, 8003,8006, 8007,8067,8101,8102,8103,8106, 8105,8106, 

2 8107 ,8108,8109,81 10,8088, 110, 8 120, 88 A 1 ,8842,8777 ,8797, 

3 8787), NERROR 

8000 MR ITE ( 6, 1 ) 

1 FORMAT ( / AX, 'ONE OF THE MATERIAL PROPERTY TABLES CANNOT BE IOENTI 
IFIED AS ISOT, ORTH, OR STIF.'/) 

GO TO 505 
8036 HR ITE ( 6,2) 

2 FORMAT ( / 4X , ' A MATERIAL PROPERTY TABLE NAME FOR A SEGMENT CANNOT 
1BE FOUND IN THE TABLE LIST.'/) 

GO TO 505 

8086 HR ITE ( 6 , 3 ) 

3 FORMAT!/ AX, 'THE TYPE OF GEOMETRY OF A SEGMENT CAfWOT BE IDENTIFI 
1E0 AS ONE HANDLEO BY THE PROGRAM. •/> 

GO TO 505 

8087 WRITEIfe.A) 

A FORMAT!/ AX, 'THE TYPE OF MATERIAL PROPERTY TABLE FOR A SEGMENT CA 
1NN0T BE IDENTIFIED AS ISOT, ORTH, OR STIF.'/) 

GO TO 505 

8089 HR ITE 1 6, 5 ) 

5 FORMAT!/ AX, 'THE HALL CONSTRUCTION OF A SEGMENT CANNOT BE IDENTIF 
1 1 ED AS SING, EQUA, UNEQ, OR BLAN.'/) 

GO TO 505 

8090 HR I TE ( 6 , 6 ) 

6 FORMAT!/ AX, 'THE TYPE OF TEMPERATURE INPUT FOR A SEGMENT CANNOT B 
IE IOENT IFIEO AS THST , NOTH, THCN, OR THIN.'/) 

8013 HR ITE ( 6, 7 ) 

7 FORMAT!/ AX, 'THE PROGRAM CANNOT RECOGNIZE THE HARDENING CLU r AS B 
1EING EITHER ISOT, KINE OR PERF.'/) 

8009 GO TO 505 
8031 HR ITE (6,9) 

9 FORMAT!/ AX, 'THE LOAD INDICATOR CLUES CAN ONLY BE ZERO, BLANK, ON 
IE, OR FOUR.'/) 

GO TO 505 
8008 HR ITE (6,10) 

10 FORMAT!/ AX, 'THE COMBINATION OF AN ORTHOTROPIC MATERIAL AND THE I 
ISOTROPIC HARDENING RULE IS NOT PRESENTLY ALLOWED.'/) 

GO TO 505 

8001 HRITE(6.U) 

11 FORMAT!/ AX, 'THE MAGIC CYCLE HAS GONE PAST STOP BY MORE THAN THE 
1PERMITTED VALUE. CHECK TO SEE IF FIXED STEP SIZE IS TOO LARGE.'/) 

GO TO 505 

8002 WRITE (6,12) 

12 FORMAT!/ AX, 'THE RIEMAN VARIABLE, I END, WHICH SIGNALS THE END OF 
1A SEGMENT SHOULD ONLY BE ZERO OR NEGATIVE ONE.'/) 


4000010 

4000020 

4000030 

4000040 

4000050 

A000060 

4000070 

4000080 

4000090 

4000100 

4000110 

4000120 

4000130 

4000140 

4000150 

4000160 

4000170 

4000180 

4000190 

4000200 

4000210 

4000220 

4000230 

4000240 

4000250 

4000260 

4000270 

4000280 

4000290 

4000300 

4000310 

4000320 

4000330 

4000340 

4000350 

4000360 

4000370 

4000380 

4000390 

4000400 

4000410 

4000420 

4000430 

4000440 

4000450 

4000460 

4000470 

4000480 

4000490 

4000500 

4000510 

4000520 

4000530 

4000540 

4000550 

4000560 

4000570 

4000580 

4000590 
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8003 GO TO 505 

8006 GO TO 505 

8007 HR ITE! 6, 15 I - 

15 FORMAT ( / AX, 'THE 
1AL PROPERTY TABLE 

GO TO 505 
8067 WRITE i 6, 16 ) 

16 FORMAT ( / AX, 'THE 


A000600 
A000610 
A000620 
A000630 
A0006AC 
A000650 
A000660 

INTERPOLATED VALUE OF TEMPERATURE FOR THE MATERI A000670 


INTERPOLATED VALUE OF TEMPERATURE FOR THE MATERI 
IS LESS THAN THE SECOND TEMPERATURE VALUE.'/) 



1AL PROPERTY TABLE 

IS 

GREATER THAN THE LAST VALUE OF TEMPERATURE.' 

A000680 

8101 

17 

2/) 

GO TO 505 
WR ITEI6, 17) 
FORMAT!/ AX, 'THE 

Kll 

STIFFNESS 

PARAMETER 

IS 

ZERO. •/ ) 

A000690 

A000700 

A000710 

A000720 

8102 

18 

GO TO 505 
WR ITE ( 6, 18 ) 
FORMAT!/ AX, 'THE 

K12 

STIFFNESS 

PARAMETER 

IS 

ZERO.'/) 

A000730 

A0007A0 

A000750 

8103 

19 

GO TO 505 
WR ITE 1 6, 19) 

FORMAT !/ AX, 'THE 

K21 

STIFFNESS 

PARAMETER 

IS 

ZERO. •/ > 

A000760 

A000770 

A000780 

8 10 A 
20 

GO TO 505 
WR ITE! 6, 20 ) 
FORMAT!/ AX, 'THE 

K22 

STIFFNESS 

PARAMETER 

IS 

ZERO.'/ ) 

A000790 

A000800 

AOOOBIO 

8105 

21 

GO TO 505 
WR ITE ( 6, 21 ) 
FORMAT!/ AX, 'THE 

K33 

STIFFNESS 

PARAMETER 

IS 

ZERO. •/ ) 

A000820 

A000830 

A0008AO 

8106 

22 

GO TO 505 
WR ITE ! 6 , 22 ) 
FORMAT!/ AX, 'THE 

Dll 

STIFFNESS 

PARAMETER 

IS 

ZERO. •/ ) 

A 000 8 50 
A000860 
A000870 

8107 

23 

GO TO 505 
WRITEI6.23) 
FORMAT!/ AX, 'THE 

012 

STIFFNESS 

PARAMETER 

IS 

ZERO. '/ ) 

A000880 

A000890 

A000900 

8108 

2A 

GO TO 505 
WRITE16, 2A ) 
FORMAT!/ AX, 'THE 

021 

STIFFNESS 

PARAMETER 

IS 

ZERO.'/) 

A000910 

A000920 

A000930 

8109 

25 

GO TO 505 
WR ITE 1 6, 25 ) 
FORMAT!/ AX, 'THE 

022 

STIFFNESS 

PARAMETER 

IS 

ZERO. •/ ) 

A0009AO 

A000950 

A000960 

8110 

26 

GO TO 505 
WRITE !6, 26 ) 
FORMAT!/ AX, • THE 

D33 

STIFFNESS 

PARAMETER 

IS 

ZERO. •/ ) 

A000970 
A000980 
A 000990 

8088 

GO TO 505 
WRITE (6,27) 






A001000 

A001010 


27 


PROGRAM CANNOT DETERMINE WHETHER THE PROBLEM INP 
RWA1, RWA2, RWA3 , ST10, ST11, ST12, ST13, ISG1, 


A001020 
A001030 
A0010A0 
A001050 
A001060 

OUTPUT IS SINGULAR A001070 
A001080 


FORMAT ( / AX, 'THE 
1UT IS THIC, RWAF , 

21SG2, OR I SG3. ' / ) 

110 GO TO 505 
8120 WR ITE ( 6 , 29 ) 

29 FORMAT 1 / AX, 'THE Y2 BLOCK IN THE SEGMENT MAGIC 

1 .'/) 

GO TO 505 
88A1 WR ITE 1 6, 30) 

30 FORMAT ( / AX, 'IN THE COMPUTATION OF THE REGION STIFFNESSES, THE 
12 MATRIX WAS NOT POSITIVE DEFINITE.'/) 

GO TO 505 
88A2 WRITE (6,31) 

31 FORMAT ( / AX, 'IN THE COMPUTATION OF THE REGION LOADS, THE K22 MATR A00I150 

1IX WAS NOT POSITIVE DEFINITE.'/) A001160 

GO TO 505 A001170 

8777 WRITE! 6, 32 ) , A001180 

32 FORMAT!/ AX, 'IN THE COMPUTATION OF THE REDUCED FLEXIBILITY MATRIX A001190 

l, THE REDUCED STIFFNESS MATRIX IS SINGULAR.'/) A001200 


A001090 
A001100 
K2 A 001110 
A001120 
A001130 
A0011A0 
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GO TO 505/ 4001210 

8797 WRITEI6,;33> 4001220 

33 FORMAT ( / 4X,*F0R KINEMATIC LINKS BETWEEN SEGMENTS, THE DEPENDENT 4001230 

1J0INT NUMBER MUST BE GREATER THAN THE INDEPENDENT JOINT NUMBER. 1 /> 4001240 

GO TO 505 4001250 

8787 WR ITE ( 6, 34 1 4001260 

34 FORMAT ( / 4X,*THE NUMBER OF POINTS IN THE ST TABLE MUST BE BETWEEN 4001270 

1 2 ANO 30.'/ J 4001280 

505 RETURN 4001290 


4001250 

4001260 


END 


4001300 
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